Topic: mimic 2008 Join Command

[A_LOTA_NOTA]

I am stuck with 2Ki  but did have the chance to use the trial version of 2008. I really liked the "Join" command that it has. So I thought I would try to write a lisp that mimics this command. I haven't done many lisp & what little I know has been self taught. I have been working on the circle portion of the program but it doesn't work right. Anyway here is what I have so far!

Thanks for the help!

Code: [Select]

(defun c:Join ()
  (setq Source nil)
  (while (not Source); checks to make sure something was selected
    (setq Source (entsel "\nSelect source object:")); select first segment
    (setq Entz (car Source)); entity name
    (setq Obj (cdr (assoc 0 (entget Entz)))); entity type
    (while (and (/= Obj "LINE") (/= Obj "LWPOLYLINE") (/= Obj "ARC") (/= Obj "ELLIPSE") (/= Obj "SPLINE")); if Source object is not supported
      (princ "\nLine, open polyline, arc, elliptical arc, or open spline expected.")
      (setq Source (entsel"\nSelect a supported object:"))
      (setq Entz (car Source)); entity name
      (setq EnList (entget Entz)); group codes
      (setq Obj (cdr (assoc 0 (entget Entz)))); entity type
      ); end while
    ); end while
  (redraw Entz 3); highlight entity

  (cond

    ((= Obj "LINE")
     (Join_LINES)     
     )

    ((= Obj "LWPOLYLINE")
     (Join_LWPOLYLINES)
     )

    ((= Obj "ARC")
     (Join_ARCS)
     )

    ((= Obj "ELLIPSE")
     (Join_ELLIPSE)
     )

    ((= Obj "SPLINE")
     (Join_SPLINES)
     )
   
    ); end cond

  (princ)
  ); end defun

(defun Join_LINES ()
  (redraw Entz 4)
  (princ "\nSorry I have not finished the line Section yet!.")
  ); end defun

(defun Join_LWPOLYLINES ()
  (redraw Entz 4)
  (princ "\nSorry I have not finished the lwpolyline Section yet!.")
  ); end defun

(defun Join_Arcs (/ SS Entz CCent CRad CNew Loop SSl SS_Del Count SAng EAng ELst Sorted LList STest Ent EnList NewLst)
  (setq SS (ssadd)); initialize selection set
  (while (/= Loop 1); begin loop
    (if (= Obj "ARC")
      (progn
(if (= (sslength ss) 0)
  (progn
    (initget 1 "Close C")
    (setq
      Entz
       (entsel "\nSelect arcs to join to source or [Close]:")
    ); select next segment
  ); end prog
  (progn
    (setq Entz (entsel "\nSelect arcs to join to source:"))
  ); end progn
); end if
(if (= Entz "Close")
  (progn
    (setq Entz (car Source)); entity name
    (setq CCent (cdr (assoc 10 (entget Entz)))); retrieve center point
    (setq CRad (cdr (assoc 40 (entget Entz)))); retrieve radius
    (command ".Circle" CCent CRad)
    (setq CNew (entlast))
    (command ".MatchProp" Entz CNew "")
    (entdel Entz)
    (princ "\nArc converted to a circle.")
    (setq Loop 1); set Loop to 1 to end loop
  ); end progn
  (progn
    (if (/= Entz nil); if selection is not empty then...
      (progn
(setq Entz (car entz)); entity name
(setq Obj (cdr (assoc 0 (entget Entz)))); entity type
(while (/= Obj "ARC")
  (princ (strcat " 1 found, " (itoa ssl) " total")); output results
  (setq
    Entz (entsel "\nSelect arcs to join to source:")
  )
  (setq Entz (car Entz))
  (setq Obj (cdr (assoc 0 (entget Entz))))
); end while
      ); end progn
      (progn;...else...
(setq Loop 1); set Loop to 1 to end loop
(setq Entz (car Source)); entity name
(setq SCen (cdr (assoc 10 (entget Entz)))); retrieve center point
(setq SRad (cdr (assoc 40 (entget Entz)))); retrieve radius
(setq SSl (sslength SS)); selection set length
(setq SS_Del (ssadd)); initialize selection set
(setq Count 0)
(while (< Count SSl); begin loop
  (setq Entz (ssname SS Count)); get next item from selection set
  (setq CCen (cdr (assoc 10 (entget Entz)))); retrieve center point
  (setq CRad (cdr (assoc 40 (entget Entz)))); retrieve radius
  (if (and (equal SCen CCen 0.000001) (equal SRad CRad 0.000001))
    (progn
      (setq Count (+ Count 1)); add to count
      ); end progn
    (progn
      (ssadd Entz SS_Del); add to selection set
      (redraw Entz 4); unhighlight entity
      (setq Count (+ Count 1)); add to count
      ); end progn
    ); end if
  ); end while
(setq SS_Dell (sslength SS_Del))
(setq Count 0)
(while (< Count SS_Dell)
  (ssdel (ssname SS_Del Count) SS)
  (setq Count (+ Count 1))
  ); end while
(setq SSl (sslength SS))
(setq Count 0)
(while (< Count SSl)
  (setq Entz (ssname SS Count)); get next item from selection set
  (setq SAng (cdr (assoc 50 (entget Entz)))); retrieve start angle
  (setq EAng (cdr (assoc 51 (entget Entz)))); retrieve end angle
  (setq ELst (append ELst (list SAng))); append to list
  (setq ELst (append ELst (list EAng))); append to list
  (setq Count (+ Count 1))
  ); end while
(setq Entz (car Source)); entity name
(setq SAng (cdr (assoc 50 (entget Entz)))); retrieve start angle
(setq EAng (cdr (assoc 51 (entget Entz)))); retrieve end angle
(setq ELst (append ELst (list SAng))); append to list
(setq Sorted (vl-sort ELst 'Compare_Arc_Points))
(setq LList (length Sorted))
(setq Count 0)
(while (and (< Count LList) (/= Stest Sang))
  (setq STest (nth Count Sorted))
  (setq Count (+ Count 1))
  ); end while
(if (/= Count LList)
  (setq EAng (nth Count Sorted))
  (setq EAng (car Sorted))
  ); end if
(setq SSL (sslength SS))
(setq Count 0)
(while (< Count SSl)
  (entdel (ssname SS Count))
  (setq Count (+ Count 1))
  ); end while
(setq Ent (car Source)); get Source name
(setq EnList (entget ent)); group codes
(setq NewLst (subst (cons 50 SAng)(assoc 50 EnList) EnList))
(setq NewLst (subst (cons 51 EAng)(assoc 51 NewLst) NewLst))
(entmod NewLst); changes the old
(entupd Ent); regenerates the entity
(setq Source nil)
(Cond
  ((and (= SS_Dell 0)
(<= SSl 1)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source")); output results
   )

  ((and (= SS_Dell 0)
(>= SSl 2)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source"));output results
   )

  ((and (= SS_Dell 1)
(<= SSl 0)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source, " (itoa (sslength SS_Del)) " Object discarded from operation"));output results
   )

  ((and (= SS_Dell 1)
(<= SSl 1)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source, " (itoa (sslength SS_Del)) " Object discarded from operation"));output results
   )

  ((and (<= SS_Dell 2)
(>= SSl 2)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source, " (itoa (sslength SS_Del)) " Objects discarded from operation"));output results
   )

  ((and (<= SS_Dell 2)
(<= SSl 1)
); end and
   (princ "\n")
   (princ (strcat (itoa SSl) " arcs joined to source, " (itoa (sslength SS_Del)) " Objects discarded from operation"));output results
   )
 
  ); end cond
); end progn
      ); end if
    ); end progn
  ); end if
); end progn
      ); end if

    (if (/= Loop 1)
      (progn
(redraw Entz 3); highlight entity
(setq SSitem Entz); store ename
(setq SSl (sslength SS)); get selection set length

(cond
  ((and (= (ssmemb Entz SS) nil)
(< SSl 1)
   ); end and
   (ssadd SSitem SS); add it to selection set
   (setq SSl (sslength SS))
   (princ (strcat " 1 found")); output results
   (redraw SSitem 3); highlight it
  )

  ((and (= (ssmemb Entz SS) nil)
(>= SSl 1)
   ); end and
   (ssadd SSitem SS); add it to selection set
   (setq SSl (sslength SS))
   (princ (strcat " 1 found, " (itoa SSl) " total")); output results
   (redraw SSitem 3); highlight it
  )

  ((and (/= (ssmemb Entz SS) nil)
(>= SSl 2)
   ); end and
   (ssadd SSitem SS); add it to selection set
   (setq SSl (sslength SS))
   (princ (strcat "1 found" " (1 duplicate)," (itoa SSl) " total")
   ); output results
  )

); end cond
      ); end progn
    ); end if
  ); end while
 
  ); end defun

(defun Join_ELLIPSE ()
  (redraw Entz 4)
  (princ "\nSorry I have not finished the ellipse Section yet!.")
  ); end defun

(defun Join_SPLINES ()
  (redraw Entz 4)
  (princ "\nSorry I have not finished the spline Section yet!.")
  ); end defun

;;; set the undo point ;;;
(defun UndoBegin ()
(vla-EndUndoMark *doc*)
(vla-StartUndoMark *doc*)
)

(defun UndoEnd ()
(vla-EndUndoMark *doc*)
)

(defun Compare_Arc_Points (a b / fuzz)
  (setq fuzz 1.0e-6)
  (if (equal a b fuzz)
    (if (equal a b fuzz)
      (> a b)
      (> a b)
    )
    (> a b)
  )
)

[CAB]

How does the 2008 JOIN command differ?

Tip:
You can use this:

Code: [Select]

(not (member Obj '("LINE" "LWPOLYLINE" "ARC" "ELLIPSE" "SPLINE")))in place of this:

Code: [Select]

(and (/= Obj "LINE") (/= Obj "LWPOLYLINE") (/= Obj "ARC") (/= Obj "ELLIPSE") (/= Obj "SPLINE"))

[A_LOTA_NOTA]

Thanks for the info CAB!! This is the type of stuff I want to learn! I haven't had any time to work on this code after posting it. But i know it could be a lot cleaner & mad to work correctly. I hope I can get back on it in the next day or so!

I think I just have a few bugs in the code that makes it not give the desired result sometimes!