Message 1 of 4
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Is there a need to clean up this lisp? It's working fine but feels over bloated.
I need it to keep allowing the user to visually scale the block before insertion (since scaling it after insertion will result in wrong y-position value).
Plus, currently it gives unique names to each created block, which is necessary because each created block will have a different elevation base (datum), so I need that feature to stay.
(defun dtr (x)
(* pi (/ x 180.0))
)
(defun c:flv (/ elv1 ss0 pp0 oldmode oldlayer ss1 ss2 ss3 ss4 ss5 pt1 pt2 pt3 ll1 ll2 xscale vObjid)
(command "_.undo" "_begin")
(setq otstyle (getvar "textstyle"))
(if (setq elv1 (getreal "\nSpecify Elevation <0.0>: ")) nil (setq elv1 0.0 ))
(if (setq pp0 (getpoint (strcat "Specify Base point of " (rtos elv1 2 2 ) " or <0,0,0>:") )) nil (setq pp0 (list 0 0 0)) )
(setq ss0 1.0)
(setq oldmode (getvar "osmode"))
(setvar "osmode" 0)
(setq oldlayer (getvar "clayer"))
(command "-layer" "m" "FLV" "c" "10" "" "LW" "0.13" "" "" )
(setq pt0 (- (nth 1 pp0) elv1))
(setq pt1 (list 0.0 pt0 0.0))
(setq pt2 (polar pt1 (dtr 135.0) (* ss0 1)))
(setq pt3 (polar pt1 (dtr 45.0) (* ss0 1)))
(command "solid" pt1 pt2 pt3 "" "")
(setq ss1 (entlast))
(setq ll1 (polar pt2 (dtr 90.0) (* ss0 0.03)))
(setq ll2 (polar ll1 (dtr 0.0) (* ss0 4)))
(command "line" ll1 ll2 "" )
(setq ss2 (entlast))
(command "_copybase" (list 0 0 0 ) ss1 ss2 "" )
(command "_pasteblock" (list 0 0 0) )
(setq ss3 (entlast))
(setq vObjid (vla-get-ObjectID (vlax-ename->vla-object ss3 )))
(command "_erase" ss1 ss2 "" )
(command "-style" "FLV" "arial" "0" "1" "0" "n" "n" )
(command "-text" "j" "br" ll2 ss0 "0" "FLV" )
(setq ss4 (entlast))
(command "_copybase" pt1 ss3 ss4 "" )
(command "_erase" ss3 ss4 "" )
(command "_pasteblock" pp0 )
(princ "\nSpecify scale (hit Enter to use last scale): ")
(command "SCALE" "LAST" "" pp0 "_non" pause)
(setq ss5 (entlast))
;; Store the X scale of the last created block
(setq xscale (cdr (assoc 41 (entget ss5))))
;; Erase ss5
(command "_erase" ss5 "" )
;; Redo the process with the stored scale value
(setq ss0 xscale)
(setq pt0 (- (nth 1 pp0) elv1))
(setq pt1 (list 0.0 pt0 0.0))
(setq pt2 (polar pt1 (dtr 135.0) (* ss0 1)))
(setq pt3 (polar pt1 (dtr 45.0) (* ss0 1)))
(command "solid" pt1 pt2 pt3 "" "")
(setq ss1 (entlast))
(setq ll1 (polar pt2 (dtr 90.0) (* ss0 0.03)))
(setq ll2 (polar ll1 (dtr 0.0) (* ss0 4)))
(command "line" ll1 ll2 "" )
(setq ss2 (entlast))
(command "_copybase" (list 0 0 0 ) ss1 ss2 "" )
(command "_pasteblock" (list 0 0 0) )
(setq ss3 (entlast))
(setq vObjid (vla-get-ObjectID (vlax-ename->vla-object ss3 )))
(command "_erase" ss1 ss2 "" )
(command "-style" "FLV" "arial" "0" "1" "0" "n" "n" )
(command "-attdef" "" "FLV" "" (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId \"" (itoa vObjid) "\">%,1).InsertionPoint \\f \"%lu2%pt2%pr2\">%") "j" "br" ll2 ss0 "0" )
(setq ss4 (entlast))
(command "_copybase" pt1 ss3 ss4 "" )
(command "_erase" ss3 ss4 "" )
(command "_pasteblock" pp0 )
(setvar "osmode" oldmode)
(setvar "clayer" oldlayer )
(setvar "textstyle" otstyle)
(command "_.undo" "_end")
(princ)
)
Solved! Go to Solution.