Selection by object - endpoint to endpoint.

By Sim
sim@acadsystems.com
ACAD Systems Sdn Bhd
https://acadsystems.com
+6019-4125950

;; Command for autoselect endpoint to endpoint
;; Command in autocad is CXX4
;; selected object put in variable = !ggg4
;;

;;usefull in CIVIL - select joining line for bearing distance.
;; only support line and arc

;;lisp program below :
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Select by pick one object that  found nes in sequence
;; global variable ggg4 - used !ggg4
(DEFUN C:Cxx4 (/ cclayer  cccolor p1     p2     p3     p4    p5   pp1  pp2
    pp3    mm1   mm2  mm3 ap1 ap2    ap2    lp1    lp2    lp3   cc  ptlist
    ptxlist   aa  m1 cc ent1   nx     nx1    nn    pttlist  sent  ss1
   )
  (defun gentt (aax / a1 dd p1 p2 p3)
    (setq dd (entget aax))
    (setq a1 (cdr (assoc 0 dd)))
    (setq p1 a1)
    ;(princ p1)
  )
  (defun ppline (aax / a1 dd p1 p2 p3)
    (setq dd (entget aax))
    (setq a1 (cdr (assoc 10 dd)))
    (setq p1 a1)
    (setq a1 (cdr (assoc 11 dd)))
    (setq p2 a1)
    (setq p3 (list p1 p2))
   ; (princ p3)
  )
  (defun pparc (aax / a1 arade arads arad dd p1 p2 p3)
    (setq dd (entget aax))    (setq a1 (cdr (assoc 10 dd)))
    (setq arad (cdr (assoc 40 dd)))    (setq arads (cdr (assoc 50 dd)))
    (setq arade (cdr (assoc 51 dd)))    (setq p1 (polar a1 arads arad))
    (setq p2 (polar a1 arade arad))    (setq p3 (list p1 p2))    ;(princ p3)
  )

  (defun cgotp (aap1 plist / rr1 rr nn cc p1 p2 p3 p4 d1 d0)
    (setq nn 0  rr "0"    )
    (while (setq p1 (nth nn plist))
      (setq d1 (distance aap1 p1))
      (if (< d1 0.0001)
(progn  (setq nn 1000)  (setq rr "1") )      )      (setq nn (+ nn 1))
    ) ;
    ;(princ rr)
    (setq rr1 rr)
  ) ;end cgotp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq ggmode (getvar "osmode"))  (setq gglayer (getvar "CLAYER"))
;;;SET OSNAP TO 0 FIRST...
  (setvar "osmode" 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq m1 (ssadd))  (setq Mm1 (ssadd))  (setq cclayer "0")

  (setq cc "1")  ;(while (= cc "1")
;;;reset master selection
    (setq m1 nil)    (setq m1 (ssadd))    (setq ptlist nil)    (setq ptxlist nil)    (setq pttlist nil)    (setq mm1 nil)    (setq mm1 (ssadd))
    (setq aa (entsel "\n Pick  object line or arc only     noted : support line and arc joining endpoint only : "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (if (= aa nil)
      (progn (setq cc "0") (princ "\n No object selected..exit") (setvar "osmode" ggmode)  (setvar "cmdecho" 1) (princ "\n Exit...") (exit)
      )
      (progn (princ "\n Process find joining selection....") (setq cc "1") (setq aa (car aa)) (setq m1 (ssadd aa m1))
(setq ent1 (gentt aa))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;for first entity
(if (= ent1 "LINE")
  (progn    (setq mm1 (ssadd aa mm1))    (setq p1 (car (ppline aa)))    (setq p2 (cadr (ppline aa)))    (setq ptlist (append (list p1) ptlist))
   (setq ptlist (append (list p2) ptlist))    (setq pttlist (append (list p1) pttlist))    (setq pttlist (append (list p2) pttlist)) ) ;end line progn
) ;end line

(if (= ent1 "ARC")
  (progn
   (setq cc "0")    (setvar "osmode" ggmode)    (princ "\n Pocket select is ARC ..."  )    (setq p1 (car (pparc aa)))    (setq p2 (cadr (pparc aa)))
   (setq ptlist (append (list p1) ptlist))    (setq ptlist (append (list p2) ptlist))   ) ;end line progn
) ;end arc

(if  (/=  ent1 "LINE")
(progn (princ "\n object selected not a line") (if  (/= ENT1 "ARC") (progn (princ "\n Object selected not LINE or ARC...exit") (exit)
) ) ) );

(setq gp1 p1  gp2 p2) ;;end for first entity ;(princ ptlist)
(princ "\n continue next entity..")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;select other entity to join ...auto....from Gp1... then from Gp2
(setq nx 0)
(while (setq p1 (nth nx ptlist))
 (setq ptxlist nil)  (setq p1a (polar p1 0.78 0.1))  (setq p1b (polar p1 3.9 0.1))  (command "zoom" "c" p1 "10")  (setq ss1 nil)
 (setq ss1 (ssget "C" p1a p1b (list (cons 0 "LINE,ARC"))))       (command "zoom" "p")
 (if (= ss1 nil)
  (progn   (princ "\n Make sure set ucs to world  and now program autoset ucs to world .. rerun the program..")   (command "ucs" "w")   (exit)   )
 );end ss1 =nil
 (setq nx1 0)
(while (setq dd2 (ssname ss1 nx1))
   (if (= dd2 (ssmemb dd2 m1))      (progn ;;member dun need to do...skip
(princ "member skip")      )
     (progn  ;; not member need to check meet member spec...if yes add to member m1
;; if not skip dun process the object.
(setq ent1 (gentt dd2))
(if (= ent1 "LINE")
 (progn    (setq p1 (car (ppline dd2)))    (setq p2 (cadr (ppline dd2)))

   (if (or (= (cgotp p1 ptlist) "1")    (= (cgotp p2 ptlist) "1") )
     (progn
;;;;found point meet spec. and condition...move entity to m1 also added p1 or p2 to ptlist
(setq m1 (ssadd dd2 m1)) (setq mm1 (ssadd dd2 mm1))
(if (/= (cgotp p1 ptlist) "1")
 (progn    (setq ptlist (append (list p1) ptlist))    (setq ptxlist (append (list p1) ptxlist))    (setq pttlist (append (list p1) pttlist))  )
) ;end if
(if (/= (cgotp p2 ptlist) "1")
 (progn    (setq ptlist (append (list p2) ptlist))    (setq ptxlist (append (list p2) ptxlist))    (setq pttlist (append (list p2) pttlist))  )
) ;end if
     )
     (progn (princ "entity line not the member ")      )    )  ) ;end line progn
) ;end line

(if (= ent1 "ARC")
 (progn    (setq p1 (car (pparc dd2)))    (setq p2 (cadr (pparc dd2)))    (if (or (= (cgotp p1 ptlist) "1")    (= (cgotp p2 ptlist) "1") )
     (progn
;;;;found point meet spec. and condition...move entity to m1 also added p1 or p2 to ptlist
;(print "\n Found arc  entity")
(setq m1 (ssadd dd2 m1))
(if (/= (cgotp p1 ptlist) "1")
 (progn
   (setq ptlist (append (list p1) ptlist))    (setq ptxlist (append (list p1) ptxlist))  )
) ;end if
(if (/= (cgotp p2 ptlist) "1")
 (progn
   (setq ptlist (append (list p2) ptlist))    (setq ptxlist (append (list p2) ptxlist))  )
) ;end if
     )
     (progn
(princ "entity  arc not the member ")      )    )  ) ;end arc progn
) ;end arc
     ) ;end progn
   ) ;end if dd2
   (setq nx1 (+ nx1 1))  ) ;end while nx1

 (if (/= ptxlist nil)    (setq nx -1)  )
 (setq nx (+ nx 1))
) ;end while nx
      ) ;end progn aa
    ) ;end if aa
;(command "change" m1 "" "p" "la" cclayer "c" cccolor "")
   (setq Ggg4 m1)
;;;;;change line entity sequence
    (setq nn 0)
    (while (setq dd3 (ssname mm1 nn))      (setq nn (+ nn 1))
      ;(command "change" dd3 "" "p" "c" nn "")
    ) ;end while

;;;put no on point for line only
    (setq nn 0)    (setq ptlist (reverse ptlist))
    (while (setq dd3 (nth nn ptlist))
      (setq nn (+ nn 1))      ; (command "text" "j" "m" dd3 "0" nn "")
    ) ;end while
;(command "erase" m1 "");;;reset all the point and lisp
    (setq p1 nil  p2 nil  p3 nil  mm1 nil  m2 nil  m3 Nil  ap1 nil  ap2 nil  ptlist nil  AA NIL  pttlist nil  ptxlist nil  nn nil)
;;;;;  ) ;end while cc
  (alert " Type !ggg4 to place the selection object..")
) ;end defun cxx4 select4 lines in sequencee

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;