idea..loop...problem...

[scubastu]

Hi learned friends,

 

Achieve what exactly?

 

Here's my lisp.. it is a modified linesum lisp. My idea was, after drawing a circuit with lines, not closed (with a misclose), to apply this loop as an adjustment to apply to each line to make it a closed circuit of individual lines, by selecting each line in order after picking the misclose points. I may be going about all wrong but please let me know if so. So it works by drawing a misclose line at the end of each traverse line. Then scale it by dividing the length (from start upto the end of the line where the misclose line is drawn) with the total of all lengths of line(

 

The problem

 

Variable totdis, total distance of all lines, is null or equal to tot until end of loop but I need it within the loop to scale each line without having to select it again (minimum finger clicking (and thinking) required). It worked when the Lisp was run without the scale baggage as the variable was "full". Can I leap frog to get the total of all lines and then step back to the loop?

 

or

 

Can I store all new misclose lines into a set to go back and scale them all by the length of the line they are associated with (the line that precedes it from the first set). This is probably the way but not sure how to go about it. It will need storing of the indx along with Length of line to scale each one correctly.. then there are the base point problems which all change.

 

All I want to do is align each traverse line to the end point of the new adjustment line then make the start of the next one the same as the end of the last.. ...create a new unbroken repositioned square from a broken square.

 

(defun c:adjust()
   (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
   (setvar "osnapcoord" 1)
  (setq p1 (getpoint "n\Pick unadjusted end of Traverse")
p2 (getpoint "n\Pick closing point or start of Traverse"))
 (command "line" p1 p2 "")
(setq mis (entlast))
(setq sset (ssget '((0 . "LINE"))))
 (if sset
   (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)))
       (setq dis (distance pt1 pt2))
       (setq tot (+ tot dis))
(setq indx (1+ indx))
(command "._layer" "_M" "Misclose" "")
(command "._layer" "_C" "2" "Misclose" "")
(setvar "clayer" "Misclose")
(command "._copy" mis "" p1 pt2)
(setq obj (entlast))
(setq disa (distance p1 p2))
(if (= indx len) (setq totdis tot))
(setq dist (* (/ tot totdis) disa))
(command "._scale" obj "" pt2 "r" p1 p2 "p" dist)
)
     )
   )
)

 

thanks in advance.

 

Stu

[CarlB]

I'm not sure if you're going about it wrong...but I think so. It sure sounds like you are trying to "close a traverse" as in surveying. Search for "traverse closure crandall's rule" (a least-squares adjustment)

 

One at http://faculty.matcmadison.edu/gmahun/2006MSPS/pdf/Technical/traverse.pdf

 

yes you can loop through the lines once to get a total length.

loop again to adjust each line

or create a set with data for retrieval; work with that set rather than querying objects again.

[CAB]

Sample:

 

(defun c:adjust (/ ss tot ename i mis len ent elst ent+)
 (vl-load-com)
 (defun LayerMake(lyrname Color ltype)
   (if (tblsearch "LAYER" lyrname)
     (command "._Layer" "_Thaw" lyrname "_On" lyrname "_UnLock" lyrname "_Set" lyrname "")
     (command "._Layer" "_Make" lyrname "_Color"
            (if (or (null color)(= Color "")) "_White" Color) lyrname
            "LT" (if (or (null ltype)(= ltype "")) "Continuous" ltype) lyrname "")
   )
 )
 
 (setq oldcmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setvar "osnapcoord" 1)
 (LayerMake "Misclose" "2" nil)

 (if (and
       (setq p1 (getpoint "n\Pick unadjusted end of Traverse"))
       (setq p2 (getpoint "n\Pick closing point or start of Traverse"))
     )
   (progn
     (command "line" "_non" p1 "_non" p2 "")
     (setq mis (entlast))
   )
 )

 (if (and mis (setq ss (ssget '((0 . "LINE")))))
   (progn
     ;;  collect the ename & length in a list while getting total lenght
     (setq tot 0.0)
     (setq i -1)
     (while (setq ename (ssname ss (setq i (1+ i))))
       (setq len (vla-get-length (vlax-ename->vla-object ename)))
       (setq lst (cons (list ename len) lst))
       (setq tot (+ len tot))
     )

     ;;  don't know what you are trying to do here??????
     (foreach ent+ (reverse lst)
       (setq elst (car ent+))
       (setq dis (cadr ent+))
       (setq pt1 (cdr (assoc 10 elst)))
       (setq pt2 (cdr (assoc 11 elst)))
       (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)
     )
   )
 )
 (princ)
)

[scubastu]

Thanks guys, your replies gave me some ideas. I've got ever closer to my non-work related at work program :wink:..

 

Yes CarlB.. doing a survey adjustments program for fun using Bowditch or 'Compass rule'.

 

I eventually after newbie frustration got the program to work by using two loop structures.. The points were quite confusing as from the second line on they change beginning and end coordinates, so easier just to draw a new line representing the adjustment then replace start and end coordinates of existing lines. Now will try and include radiations and blocks to adjust with it...lol ...

 

cab didn't get your part of the program to work but that was probably because I don't know what I'm doing:?

 

Here's what I have done anyway.. feedback appreciated.. e.g. I have no error checking or such the program works correctly (I think) if user does things in order.

 

(defun c:adjust (/ 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 "._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 indx (1+ indx))
)
     )
   )
 )