LiSP Penting
Saya tidak membuat program LiSP di bawah ini. saya hanya meng-copy dari berbagai sumber.
untuk join semua polyline
(defun C:JJ ; = Polyline Join
(/ *error* pjss cmde peac nextent pjinit inc edata pjent)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(setvar 'peditaccept peac)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); defun - *error*
(princ "\nTo join objects into Polyline(s) [pick 1 to join all possible to it],")
(setq
pjss (ssget '((0 . "LINE,ARC,*POLYLINE")))
cmde (getvar 'cmdecho)
peac (getvar 'peditaccept)
nextent (entlast); starting point for checking new entities
); setq
(repeat (setq pjinit (sslength pjss) inc pjinit); PJ INITial-selection quantity & incrementer
(if
(and
(=
(cdr (assoc 0 (setq edata (entget (setq pjent (ssname pjss (setq inc (1- inc))))))))
"POLYLINE" ; 2D "heavy" or 3D Polyline
); =
(or
(= (cdr (assoc 100 (reverse edata))) "AcDb3dPolyline"); 3D
(member (boole 1 6 (cdr (assoc 70 edata))) '(2 4)); splined or fitted 2D
); or
); and
(ssdel pjent pjss); remove 3D, splined/fitted 2D from set
); if
); repeat
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setvar 'peditaccept 1)
(setvar 'plinetype 2); [just in case; assumes no desire to save and set back if different]
(if pjss ; selected qualifying object(s)
(cond ; then
( (= pjinit (sslength pjss) 1); selected only one, and it qualifies
(command "_.pedit" pjss "_join" "_all" "" ""); join everything possible to it
); single-selection condition
( (> (sslength pjss) 1); more than one qualifying object
(command "_.pedit" "_multiple" pjss "" "_join" "0.0" "")
); multiple qualifying condition
((prompt "\nSingle object not viable, or <= 1 of multiple selection viable."))
); cond
(prompt "\nNothing viable selected.")
); outer if
(while (setq nextent (entnext nextent)); start with first newly-created Pline, if any
(if ; revert any un-joined Lines/Arcs back from Pline conversion
(and ; newly-created single-segment Pline from unconnected Line/Arc
(= (cdr (assoc 90 (entget nextent))) 2)
(not (vlax-curve-isClosed nextent))
); and
(command "_.explode" nextent)
); if
); while
(setvar 'peditaccept peac)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
)
untuk menambahkan prefix (huruf atau angka di depan huuruf lain) sufix (huruf atau angka di belakang huuruf lain)
(defun C:TextPS (/ intCount objSelection strPrefix strSuffix ssSelections)
(princ "\nSelect text and mtext: ")
(setq ssSelections (ssget (list (cons 0 "TEXT,MTEXT")))
strPrefix (getstring "\nEnter Prefix: " 't)
strSuffix (getstring "\nEnter Suffix: " 't)
)
(repeat (setq intCount (sslength ssSelections))
(setq intCount (1- intCount)
objSelection (vlax-ename->vla-object
(ssname ssSelections intCount)
)
)
(vla-put-textstring objSelection
(strcat
strPrefix
(vla-get-textstring objSelection)
strSuffix
)
)
)
(prin1)
)
