[原创]带反应器的圆圈序号标注工具

admin · 发表于 2024-3-30 12:34:52

;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
;; ;;
;; AUTHOR: lihuaili, October 2009. VERSION: v 1.0 ;;
;;...............................................................................;;
;;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=;;
(vl-load-com)
(setq *ActiveDocument*
(vla-get-ActiveDocument
(vlax-get-acad-object)
) ;采用 end of vla-get-ActiveDocument
) ;采用 end of setq
(setq *ModelSpace*
(vla-get-ModelSpace
*ActiveDocument*
) ;采用 end of vla-get-ModelSpace
) ;采用 end of setq
(setq *AcadBlock*
(vla-get-blocks
*ActiveDocument*
) ;采用 end of vla-get-blocks
) ;采用 end of setq
;;;Creat Num block with attribute
(defun Creat采用Num采用block (TextHight radius /
cirPnt blockObj circleObj
attributeObj
)
(setq cirPnt (list radius radius 0.0))
(setq blockObj (vla-add *AcadBlock*
(vlax-3d-point cirPnt)
"num"
)
circleObj (vla-AddCircle
blockObj
(vlax-3d-point cirPnt)
radius
)
attributeObj
(vla-AddAttribute
blockObj
TextHight
acAttributeModeVerify
""
(vlax-3d-point cirPnt)
"nums"
""
)
)
(vla-put-Alignment attributeObj acAlignmentMiddle)
(if (> (setq v (distof (substr (getvar "acadver") 1 3))) 16.2)
(vla-put-TextAlignmentPoint
attributeObj
(vlax-3d-point cirPnt)
)
)
(vla-Update attributeObj)
)
(defun draw采用leader (pt1 pt2 / leaderobj) ;draw leader
(command "leader" pt1 pt2 "f" "st" "f" "a" "" "" "n")
(setq leaderobj (vlax-ename->vla-object (entlast)))
(vla-put-ArrowheadType leaderobj acArrowDotSmall)
(vla-Update leaderobj)
leaderobj
)
;;;set Attributes
(defun SetAtts (Obj Lst / AttVal)
(mapcar
'(lambda (Att)
(if (setq AttVal (cdr (assoc (vla-get-TagString Att) Lst)))
(vla-put-TextString Att AttVal)
)
)
(vlax-invoke Obj "GetAttributes")
)
(vla-update Obj)
(princ)
)
;;;Get numbers of block reference Object in ModelSpace
(defun Get采用blkRef采用Num (blkRef采用name / count objEnt)
(setq count 0)
(vlax-for objEnt *ModelSpace*
(if (equal (vla-get-ObjectName objEnt) "AcDbBlockReference")
(progn (if (equal (vla-get-Name objEnt) blkRef采用name)
(setq count (1+ count))
)
)
)
)
count
)
;;;check if have "num" block exist
(defun check采用num采用block (/)
(if (ssget "X"
'((0 . "INSERT")
(2 . "num")
)
)
T
nil
)
)
;;;--------------------------------------------------------------------;
;;; Function: set-params-obj ;
;;; ;
;;; Description: This function sets the parameters required ;
;;; to associate a dimension object . ;
;;; ;
;;; Arguments: ;
;;; vla-blk采用bef = a valid vla blk采用bef object. ;
;;; vla-leader = a valid vla leader object. ;
;;; ;
;;; Returned Value: coordinates to the leader object. ;
;;; ;
;;; Usage: ;
;;; (set-params-obj ;
;;; vla-blk采用bef vla-leader ;
;;; ) ;
;;;--------------------------------------------------------------------;
(defun set-params-obj
(vla-blk采用bef vla-leader / ins-pnt lead-pnt1 lead-pnt2 sca rad)
(if (and (= (type vla-blk采用bef) 'VLA-OBJECT)
(vlax-read-enabled-p vla-blk采用bef)
)
(progn
(setq ins-pnt (vla-get-InsertionPoint vla-blk采用bef))
(if (eq (type ins-pnt) 'VARIANT)
(if (> (vlax-variant-type ins-pnt) 8192)
(setq
ins-pnt (vlax-safearray->list (vlax-variant-value ins-pnt))
)
)
)
(setq sca (vla-get-XScaleFactor vla-blk采用bef)
rad (vlax-ldata-get vla-blk采用bef "radius")
lead-pnt1 (vlax-curve-getstartpoint vla-leader)
lead-pnt2 (polar ins-pnt (angle ins-pnt lead-pnt1) (* sca rad))
Coordinates (append lead-pnt1 lead-pnt2)
)
)
)
)
;;;--------------------------------------------------------------------;
;;; Function: UPDATE-PARAMETER-MDIM ;
;;; ;
;;; Description: This function is responsible for updating a ;
;;; vla-object's parameter. ;
;;; ;
;;; Arguments: ;
;;; vla-obj = a valid vla object. ;
;;; par-name = a parameter name. ;
;;; par-value = a new parameter value ;
;;; ;
;;; Returned Value: A vla object. ;
;;; ;
;;; Usage: ;
;;; (update-parameter-mdim ;
;;; vla-obj par-name par-value ;
;;; ) ;
;;;--------------------------------------------------------------------;
(defun update-parameter-mdim (vla-obj par-name par-value)
(if (and (= (type vla-obj) 'VLA-OBJECT)
(vlax-write-enabled-p vla-obj)
(not (equal (vlax-get vla-obj par-name) par-value))
)
(vlax-put vla-obj par-name par-value)
)
)
;;;--------------------------------------------------------------------;
;;; Function: UPDATE-LEADER ;
;;; ;
;;; Description: This function updates the "coordinate" property ;
;;; for the leader object. ;
;;; ;
;;; Arguments: ;
;;; notifier = a valid vla object. ;
;;; obj-list = a list of vla object. ;
;;; ;
;;; Returned Value: An updated leader object. ;
;;; ;
;;; Usage: ;
;;; (update-leader ;
;;; notifier obj-list ;
;;; ) ;
;;;--------------------------------------------------------------------;
(defun update-leader
(notifier obj-list / vla-blk采用bef vla-leader)
(setq vla-blk采用bef (nth 0 obj-list)
vla-leader (nth 1 obj-list)
)
(if (set-params-obj vla-blk采用bef vla-leader)
(update-parameter-mdim vla-leader "Coordinates" Coordinates)
)
)
;;;--------------------------------------------------------------------;
;;; Function: reactor-leader采用blk采用bef ;
;;; ;
;;; Description: This function will be called inside ;
;;; :vlr-modified event. ;
;;; ;
;;; Required Functions: ;
;;; update-leader-for-blk采用bef ;
;;; ;
;;; Arguments: ;
;;; notifier = a valid vla object. Filled in by the calling ;
;;; reactor. ;
;;; reactor = a valid vlr object reactor. Filled in by the ;
;;; calling reactor. ;
;;; arg-list = argument list filled in by the calling reactor. ;
;;; Filled in by the calling reactor. ;
;;; ;
;;; Returned Value: A valid vla object. ;
;;; ;
;;; Usage: Intended to be called from a reactor call back. ;
;;; (reactor-leader采用blk采用bef notifier reactor arg-list) ;
;;;--------------------------------------------------------------------;
(defun reactor-leader采用blk采用bef (notifier reactor arg-list)
(update-leader notifier (vlr-data reactor))
)
;;;--------------------------------------------------------------------;
;;; main Function ;
;;;--------------------------------------------------------------------;
(defun c:draw采用numbers (/ vla-leader TextHight radius
sca loop1 loop2 pt0
vla-blkref count count采用str att采用lst
vla-leader sp source Points
reactor
)
(setvar "CMDECHO" 0)
(setq TextHight 5
radius 5
sca 1
loop1 T
)
(if (not (check采用num采用block))
(Creat采用Num采用block TextHight radius)
)
(while loop1
(if (setq pt0
(getpoint
"\n点取标注点(按右键或回车退出):"
)
)
(progn
(setq vla-blkref
(vla-InsertBlock
*ModelSpace*
(vlax-3d-point pt0)
"num"
sca
sca
sca
0
)
count (Get采用blkRef采用Num "num")
count采用str (itoa count)
att采用lst (list (cons '"nums" count采用str))
loop2 T
)
(SetAtts vla-blkref att采用lst)
(setq vla-leader (draw采用leader pt0 (polar pt0 0 0.001)))
(prompt "\n确定序号放置位置:")
(while loop2
(setq sp (grread T)
source (car sp)
sp (cadr sp)
) ;采用 end setq
(cond ((= source 5)
(vla-put-InsertionPoint vla-blkref (vlax-3d-point sp))
(setq
Points
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbdouble
'(0 . 5)
)
(append pt0
(polar sp (angle sp pt0) (* radius sca))
)
)
)
(if (> (distance sp pt0) (* radius sca))
(vla-put-coordinates vla-leader Points)
)
)
(t
(progn (setq loop2 nil
obj-lst (list vla-blkref vla-leader)
)
(vlax-ldata-put vla-blkref "radius" radius)
(function reactor-leader采用blk采用bef)
(setq reactor
(VLR-Object-reactor
obj-lst
obj-lst
'((:vlr-modified . reactor-leader采用blk采用bef))
)
)
)
)
)
)
)
(setq loop1 nil)
)
)
(princ)
)

复制代码

		自动登录	找回密码
密码			立即注册

[原创]带反应器的圆圈序号标注工具

相关帖子