Before the advent of PLJOIN.LSP

[watsonlisp]

;Microstation used to cause arcs to be small line segments upon conversion to autocad.
;I wrote this one to join those segments.


(DEFUN C:GPJ (/ PT1 PT2 SSET SSETN PLN LP ENT LA PLN2 TFC CV ENTL EVS SV EVT VE1 VE2 SI1 SI2 SII1 SII2 SI SII PF FB FE FLTR)
(PROMPT "*GROUP POLYLINE JOIN*")
(SETQ SSET (SSGET '((0 . "LWPOLYLINE"))))
(SETQ SSETN (SSLENGTH SSET))
(SETQ PLN SSETN)
(PRINT SSETN)
(PROMPT " POLOYLINES SELECTED")
(SETQ SSETN (- SSETN 1))
(SETQ LOOP 1)
(WHILE LOOP
(SETQ ENT (SSNAME SSET SSETN))
(SETQ LA (ASSOC 8 (ENTGET ENT)))
(SETQ ENTL (ENTGET ENT))
(SETQ VE1 (CDR (ASSOC 10 ENTL)))
(SETQ EVS VE1)
(SETQ SV 1)
(WHILE SV
(SETQ ENTL (CDR ENTL))
(SETQ EVT (ASSOC 10 ENTL))
(IF (/= EVT NIL)
(SETQ VE2 (CDR EVT))
(SETQ SV NIL)
)
);END WHILE SV
(SETQ SI1 (MAPCAR '+ '(0.1 0.1 0.0) VE1))
(SETQ SI2 (MAPCAR '+ '(-0.1 -0.1 0.0) VE1))
(SETQ SII1 (MAPCAR '+ '(0.1 0.1 0.0) VE2))
(SETQ SII2 (MAPCAR '+ '(-0.1 -0.1 0.0) VE2))
(SETQ PF '(0 . "LWPOLYLINE"))
(SETQ FB '(-4 . "<AND"))
(SETQ FE '(-4 . "AND>"))
(SETQ FLTR (LIST FB PF LA FE))
(SETQ SI (SSGET "C" SI1 SI2 FLTR))
(SETQ SII (SSGET "C" SII1 SII2 FLTR))
(IF (= SI NIL)
(SETQ SI ENT)
)
(IF (= SII NIL)
(SETQ SII ENT)
)
(SETQ CV (CDR (ASSOC 70 (ENTGET ENT))))
(IF (> CV 0)
(SETQ TFC 1)
(SETQ TFC 0)
)
(IF (= TFC 0)
(COMMAND "PEDIT" ENT "J" SI SII "" "X")
)
(SETQ LP 1)
(WHILE LP
(SETQ SSETN (- SSETN 1))
(PROMPT "\nJOIN ATEMPT # ")
(PRINC SSETN)
(IF (/= (SSNAME SSET SSETN) NIL)
(SETQ NT (ENTGET (SSNAME SSET SSETN)))
(SETQ NT 1)
)
(IF (= NT NIL)
(SETQ LP 1)
(SETQ LP NIL)
)
(IF (< SSETN 0)
(SETQ LOOP NIL)
)
);END WHILE LP
);END WHILE LOOP
(SETQ SSET NIL)
(SETQ SSET NIL)
(PRINC)
);END JPL[ Moderator Action = ON ] What are [ CODE ] tags... (http://forums.augi.com/misc.php?do=bbcode#code) [ Moderator Action = OFF ]