scubastu
1st Nov 2009, 11:24 pm
This lisp takes each line and draws a new line calculating by bowditch (or compass rule) to make the end coordinate the same as the beginning. It finds any block at the end of the line and shifts it to its new corrected position. I've attached an dwg with an crude example of traverse. Obviously the traverse to be adjusted are the lines in the loop or circuit and you need to select these from start to finish in order.
[code](defun c:adj3 (/ mis sset tot num itm totdis
hnd ent dis indx lobj disa dist)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "osnapcoord" 1)
(command "._layer" "_M" "Misclose" "")
(command "._layer" "_C" "2" "Misclose" "")
(setvar "clayer" "Misclose")
(setq p1 (getpoint "n\Pick unadjusted end of Traverse")
p2 (getpoint "n\Pick closing point"))
(command "line" p1 p2 "")
(setq mis (entlast))
(setq sset (ssget '((0 . "LINE"))))
(if sset
(progn
(setq tot 0.0)
(setq num (sslength sset) itm 0)
(repeat num
(while (< itm num)
(setq hnd (ssname sset itm))
(setq ent (entget hnd))
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq dis (distance pt1 pt2))
(setq tot (+ tot dis))
(setq itm (1+ itm))
)
)))
(if (= itm num) (setq totdis tot))
(if totdis
(progn
(setq tot 0.0)
(setq len (sslength sset) indx 0)
(while (< indx len)
(setq lobj (ssname sset indx))
(setq objd (entget lobj))
(setq pt1 (cdr (assoc 10 objd)))
(setq pt2 (cdr (assoc 11 objd)))
(if (> indx 0) (setq pl1 pl2))
(setq dis (distance pt1 pt2))
(setq tot (+ tot dis))
(command ".erase" objd "")
(command "._copy" mis "" p1 pt2)
(setq obj (entlast))
(setq disa (distance p1 p2))
(setq dist (* (/ tot totdis) disa))
(command "._scale" obj "" pt2 "r" p1 p2 "P" dist)
(command "._layer" "_M" "Traverse Adjusted" "")
(command "._layer" "_C" "1" "Traverse Adjusted" "")
(setvar "clayer" "Traverse Adjusted")
(setq pl2 (cdr (assoc 11 (entget obj))))
(if (= indx 0) (command "._line" pt1 pl2 ""))
(if (> indx 0) (command "._line" pl1 pl2 ""))
(setq ins (ssget "_X" (list '(-4 . "=,=,*")(cons 10 pt2)(cons 0 "insert"))))
(command "._move" ins "" pt2 Pl2)
(if (> indx 0) (progn
(setq rad (ssget "_X" (list '(-4 . "=,=,*")(cons 10 pt1)(cons 0 "LINE"))))
(command "._move" rad "" pt1 pl1)))
(command ".erase" obj "")
(setq indx (1+ indx))
)
)
)
(command ".erase" mis "")
(princ)
)[code]
Now the problem.. I want to shift any lines that radiate from pnt 2 and that are not in the adjusted circuit to the same new position. <-- ok done this but a little messy.
How can I assess anymore continuing lines and blocks starting from the ends of these radiations and shift them with the radiation? Possible?
maybe something like..if radiation exist get, assoc 11, and if block or radiation exist at endpoint include in radiation set loop until nothing then continue with rest of program.??!!
[code](defun c:adj3 (/ mis sset tot num itm totdis
hnd ent dis indx lobj disa dist)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setvar "osnapcoord" 1)
(command "._layer" "_M" "Misclose" "")
(command "._layer" "_C" "2" "Misclose" "")
(setvar "clayer" "Misclose")
(setq p1 (getpoint "n\Pick unadjusted end of Traverse")
p2 (getpoint "n\Pick closing point"))
(command "line" p1 p2 "")
(setq mis (entlast))
(setq sset (ssget '((0 . "LINE"))))
(if sset
(progn
(setq tot 0.0)
(setq num (sslength sset) itm 0)
(repeat num
(while (< itm num)
(setq hnd (ssname sset itm))
(setq ent (entget hnd))
(setq pt1 (cdr (assoc 10 ent)))
(setq pt2 (cdr (assoc 11 ent)))
(setq dis (distance pt1 pt2))
(setq tot (+ tot dis))
(setq itm (1+ itm))
)
)))
(if (= itm num) (setq totdis tot))
(if totdis
(progn
(setq tot 0.0)
(setq len (sslength sset) indx 0)
(while (< indx len)
(setq lobj (ssname sset indx))
(setq objd (entget lobj))
(setq pt1 (cdr (assoc 10 objd)))
(setq pt2 (cdr (assoc 11 objd)))
(if (> indx 0) (setq pl1 pl2))
(setq dis (distance pt1 pt2))
(setq tot (+ tot dis))
(command ".erase" objd "")
(command "._copy" mis "" p1 pt2)
(setq obj (entlast))
(setq disa (distance p1 p2))
(setq dist (* (/ tot totdis) disa))
(command "._scale" obj "" pt2 "r" p1 p2 "P" dist)
(command "._layer" "_M" "Traverse Adjusted" "")
(command "._layer" "_C" "1" "Traverse Adjusted" "")
(setvar "clayer" "Traverse Adjusted")
(setq pl2 (cdr (assoc 11 (entget obj))))
(if (= indx 0) (command "._line" pt1 pl2 ""))
(if (> indx 0) (command "._line" pl1 pl2 ""))
(setq ins (ssget "_X" (list '(-4 . "=,=,*")(cons 10 pt2)(cons 0 "insert"))))
(command "._move" ins "" pt2 Pl2)
(if (> indx 0) (progn
(setq rad (ssget "_X" (list '(-4 . "=,=,*")(cons 10 pt1)(cons 0 "LINE"))))
(command "._move" rad "" pt1 pl1)))
(command ".erase" obj "")
(setq indx (1+ indx))
)
)
)
(command ".erase" mis "")
(princ)
)[code]
Now the problem.. I want to shift any lines that radiate from pnt 2 and that are not in the adjusted circuit to the same new position. <-- ok done this but a little messy.
How can I assess anymore continuing lines and blocks starting from the ends of these radiations and shift them with the radiation? Possible?
maybe something like..if radiation exist get, assoc 11, and if block or radiation exist at endpoint include in radiation set loop until nothing then continue with rest of program.??!!