Hi guys !
I use this Lisp to draw datum symbol. Prompt "left-click to confirm / right-click to cancel" ,But I right-click , can't to cancel !
Thank for any help !
(defun apolar ( pto ang len )
(polar pto (/ (* ang pi) 180) len)
)
(defun vlp ( pt )
(cond
((= (type pt) 'LIST) (vlax-3d-point pt) )
((= (type pt) 'VARIANT) (vlax-safearray->list (vlax-variant-value pt)) )
((= (type pt) 'SAFEARRAY) (vlax-safearray->list pt) )
)
)
(defun vob ( ob )
(if (= (type ob) 'ENAME) (vlax-ename->vla-object ob) (vlax-vla-object->ename ob) )
)
(defun Vla-AddPlin( pts / lis dou mod )
(setq lis (apply 'append (mapcar '(lambda (x) (list (car x) (cadr x))) pts)))
(setq dou (vlax-make-safearray vlax-vbdouble (cons 0 (1- (* 2 (length pts))))))
(setq lis (vlax-make-variant (vlax-safearray-fill dou lis)))
(setq mod (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(vla-addlightweightpolyline mod lis)
)
(defun str->lst ( str pat / )
(setq @lst '() #pn (strlen pat) #n 0)
(while (< (+ #n #pn) (strlen str))
(setq #n (vl-string-search pat str #n) #n (+ #n #pn))
(setq #sn (vl-string-search "%" (substr str (+ #n 1))))
(setq @lst (cons (substr str (+ #n 1) #sn) @lst))
)
(reverse @lst)
)
(defun dimfh-checkobject ( / @ol1 @ol2 )
(setq @obj (entget &obj) &obj (vob &obj))
(setq @ol1 (list "AcDb3PointAngularDimension" "AcDb2LineAngularDimension"))
(setq @ol1 (append @ol1 (list "AcDbRotatedDimension" "AcDbAlignedDimension")))
(setq @ol2 (list "AcDbPolyline" "AcDbLine" "AcDbCircle" "AcDbArc" "AcDbSpline"))
(cond
((member (vla-get-objectname &obj) @ol1) (setq #mod (dimfh-countpoint)) )
((member (vla-get-objectname &obj) @ol2) (setq #mod 1) )
(T (setq #mod (dimfh-getpoint 2)) )
)
(dimfh-action)
)
(defun c:fh ( / ^input #j1 #mod &obj #cm #os #la #ur &b1 &t1 ~obj @obj @p3 @p4 @p31 @p32 @p41 @p42 #an1 #an2 #an )
(setq #cm (getvar "cmdecho") #os (getvar "osmode") #la (getvar "clayer"))
(setq #ur (getvar "cursorsize") #uc (getvar "ucsorg"))
(setvar "cmdecho" 0) (setvar "osmode" 0)
(defun *error* ( msg )
(if (and &b1 (not (vlax-erased-p &b1))) (vla-erase &b1) )
(princ "*cancel*") (setq *error* nil) (dimfh-resetting)
)
(if (null vlax-dump-object) (vl-load-com) )
(if (null &mod)
(setq &mod (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
)
(if (null (tblsearch "BLOCK" "$B-C1")) (dimfh-makeblock) )
(if (null (tblsearch "LAYER" "DIM"))
(progn
(setq &la (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "DIM"))
(vla-put-color &la 6) (vla-put-linetype &la "Continuous") (vla-put-Lineweight &la 15)
)
)
(setvar "clayer" "DIM") (setvar "cursorsize" 5) (command "_.ucs" "W")
(dimfh-toolbar) (while ^kw (dimfh-toolbar) ) (dimfh-resetting)
)
(defun dimfh-toolbar ( )
(if (null %tx) (setq %tx "A") ) (if (null #sc) (setq #sc 1.0) )
(princ "\n[Draw Datum symbol] Current setting: ") (initget "G T S")
(princ (strcat "Symbol = " %tx " ， Scale = " (rtos #sc 2 2) " "))
(setq ^kw (entsel "\nChoose object OR [Choose basic point(G)/Choose Symbol(T)/Scale Set(S)]: <Choose basic point> "))
(cond
((member ^kw (list nil "G" "g")) (progn (setq ^kw nil) (dimfh-getpoint 1) ) )
((member ^kw (list "S" "s")) (progn (setq ^kw T) (dimfh-inputscale) ) )
((member ^kw (list "T" "t")) (progn (setq ^kw T) (dimfh-inputstring) ) )
(T (progn (setq &obj (car ^kw) ^kw nil) (dimfh-checkobject) ) )
)
)
(defun dimfh-inputstring ( )
(initget "S") (setq ^tx (getstring (strcat "\nPlease Enter New Text OR [Extract text.(S)]: <" %tx "> ")))
(cond
((member ^tx (list "s" "S")) (dimfh-textselect) )
((null ^tx) (setq ^tx %tx) )
)
(setq %tx (strcase ^tx))
)
(defun dimfh-textselect ( )
(if (setq ^tx (entsel (strcat "\nChoose Text object: <" %tx ">")))
(progn
(setq ^tx (car ^tx) @tx (entget ^tx) #tx (cdr (assoc 0 @tx)))
(cond
((= #tx "TOLERANCE") (setq ^tx (str->lst (cdr (assoc 1 @tx)) "%%v")) )
((= (cdr (assoc 0 @tx)) "TEXT") (setq ^tx (list (cdr (assoc 2 @tx)))) )
(T (setq ^tx nil) )
)
(foreach txl ^tx
(if (and (> (ascii txl) 64) (< (ascii txl) 91))
(setq ^tx txl)
)
)
)
)
(if (/= (type ^tx) 'STR)
(progn
(princ "\n**Text not fetched!**") (setq ^tx %tx)
)
)
)
(defun dimfh-inputscale ( )
(if (setq ^sc (getreal (strcat "\nEnter the new scale: <" (rtos #sc) "> ")))
(setq #sc ^sc)
)
)
(defun dimfh-resetting ( )
(setvar "clayer" #la) (setvar "osmode" #os) (setvar "cursorsize" #ur)
(if (not (equal #uc (list 0 0 0) 0.001)) (command "_.ucs" "o" #uc) )
(setvar "cmdecho" #cm) (princ)
)
(defun dimfh-getpoint ( #st / @p3 @p4 )
(setvar "osmode" #os) (setvar "cursorsize" #ur)
(if (= #st 2) (setq %st "The object can not take the points automatically") (setq %st "") )
(if (setq @p3 (getpoint (strcat "\n" %st "Select the basic point: ")))
(if (setq @p4 (getangle @p3 "\nPlease select the direction or enter the angle: "))
(progn
(if (= (type @p4) 'LIST)
(setq #ang (angle @p3 @p4))
(setq #ang (/ (* @p4 180) pi))
)
(dimfh-insertblock)
(vla-put-insertionpoint &b1 (vlp @p3))
(vla-put-rotation &b1 (- #ang (* pi 0.5)))
(vla-put-rotation &t1 0)
(setq %tx (chr (1+ (ascii %tx))))
)
)
)
nil
)
(defun dimfh-action ( )
(princ "\n>[left-click to confirm / right-click to cancel]<")
(while #mod
(dimfh-insertblock) (setq @jj (grread 1 4 0) #j1 (car @jj) #j2 (cadr @jj))
(cond
((= #j1 12) (setq #mod (vla-erase &b1)) )
((= #j1 3) (setq %tx (chr (1+ (ascii %tx))) #mod nil) )
((= #j1 5) (dimfh-move) )
)
)
)
(defun dimfh-makeblock ( / &l1 &l2 &ci &at )
(setvar "clayer" "0") (setvar "cecolor" "bylayer") (setvar "celtype" "bylayer")
(setq &l1 (vla-addline &mod (vlp (list -1 0 0)) (vlp (list 1 0 0))))
(setq &l2 (vla-addline &mod (vlp (list 0 0 0)) (vlp (list 0 1 0))))
(setq &ci (vla-addcircle &mod (vlp (list 0 2 0)) 1))
(setq &at (vla-addattribute &mod 1 acattributemodepreset "" (vlp (list 0 2 0)) "NUM" ""))
(vla-put-alignment &at 4) (vla-put-TextAlignmentPoint &at (vlp (list 0 2 0)))
(command "_.block" "$B-C1" (list 0 0 0) (vob &l1) (vob &l2) (vob &ci) (vob &at) "")
)
(defun dimfh-insertblock ( )
(if (or (null &b1) (/= (type &b1) 'VLA-OBJECT) (vlax-erased-p &b1))
(progn
(setq &b1 (vla-insertblock &mod (vlp (list 0 0 0)) "$B-C1" #sc #sc #sc 0))
(setq &t1 (car (vlp (vla-getattributes &b1))))
(vla-put-color &b1 256) (vla-put-textstring &t1 %tx)
)
)
)
(defun dimfh-countpoint ( / p10 p11 p12 p13 p14 p15 p16 )
(setq p10 (cdr (assoc 10 @obj)) p11 (cdr (assoc 11 @obj)) p13 (cdr (assoc 13 @obj)))
(setq p14 (cdr (assoc 14 @obj)) p15 (cdr (assoc 15 @obj)) p16 (cdr (assoc 16 @obj)))
(cond
((= (vla-get-objectname &obj) "AcDbRotatedDimension")
(progn
(setq @p4 (inters p10 p11 p13 (polar p13 (angle p14 p10) 2) nil))
(setq @p3 p10 #an1 (angle @p3 p14) #an2 (angle @p4 p13))
)
)
((= (vla-get-objectname &obj) "AcDbAlignedDimension")
(progn
(setq @p4 (inters p10 p11 p13 (polar p13 (angle p14 p10) 2) nil))
(setq @p3 p10 #an1 (angle @p3 p14) #an2 (angle @p4 p13))
)
)
((= (vla-get-objectname &obj) "AcDb3PointAngularDimension")
(progn
(setq @p3 (polar p15 (angle p15 p13) (distance p11 p15)))
(setq @p4 (polar p15 (angle p15 p14) (distance p11 p15)))
(setq #an1 (angle @p3 p15) #an2 (angle @p4 p15))
)
)
((= (vla-get-objectname &obj) "AcDb2LineAngularDimension")
(progn
(setq p17 (inters p10 p15 p13 p14 nil))
(setq #an1 (if (equal p10 p17 0.001) (angle p17 p15) (angle p17 p10) ) )
(setq #an2 (if (equal p13 p17 0.001) (angle p17 p14) (angle p17 p13) ) )
(setq @p3 (polar p17 #an1 (distance p17 p16)))
(setq @p4 (polar p17 #an2 (distance p17 p16)))
)
)
)
(setq @p31 (polar @p3 (+ #an1 (* pi 0.5)) 1) @p32 (polar @p3 (+ #an1 (* pi 1.5)) 1))
(setq @p41 (polar @p4 (+ #an2 (* pi 0.5)) 1) @p42 (polar @p4 (+ #an2 (* pi 1.5)) 1))
0
)
(defun dimfh-move ( )
(cond
((= #mod 0)
(if (< (distance @p3 #j2) (distance @p4 #j2))
(if (< (distance @p31 #j2) (distance @p32 #j2))
(setq @pc1 @p3 #an (angle @p31 @p3))
(setq @pc1 @p3 #an (angle @p32 @p3))
)
(if (< (distance @p41 #j2) (distance @p42 #j2))
(setq @pc1 @p4 #an (angle @p41 @p4))
(setq @pc1 @p4 #an (angle @p42 @p4))
)
)
)
((= #mod 1)
(setq @pc1 (vlax-curve-getclosestpointto &obj #j2) #an (angle #j2 @pc1))
)
)
(vla-put-insertionpoint &b1 (vlp (polar @pc1 (+ #an pi) 0.5)))
(vla-put-rotation &b1 (+ #an (/ pi 2)))
(vla-put-rotation &t1 0)
)
