- ;;函 数
- ;;功 能:关联引线+注释
- ;;方 法:(Cq-Ldr&txt 引线图元 文本图元)
- (defun Cq-Ldr&txt (LDR TXT / acaddocument acadobject annotationobject leaderobj leadertype lst mspace num obj pnts sc x)
- (VL-LOAD-COM)
- (setq AcadObject(vlax-get-acad-object)
- AcadDocument(vla-get-ActiveDocument Acadobject)
- mSpace(vla-get-ModelSpace Acaddocument)
- )
- (setq lst(apply 'append(mapcar 'cdr(vl-remove-if-not '(lambda(x)(= 10(car x)))(entget ldr)))))
- (setq num (1-(length lst)))
- ;;; 引线数据
- (setq pnts(vlax-make-safearray vlax-vbDouble (cons 0 num)))
- (vlax-safearray-fill pnts lst)
- ;;;引线类型:acLineNoArrow、acLineWithArrow、acSplineNoArrow 或 acSplineWithArrow
- (setq leaderType acLineWithArrow)
- ;;附着对象
- (setq annotationObject (vlax-ename->vla-object TXT))
- ;;关联,返回引线对象
- (setq leaderOBJ(vla-AddLeader mSpace pnts annotationObject leaderType))
- ;;修改引线对象比例
- (setq sc(vla-get-ScaleFactor(vlax-ename->vla-object ldr)))
- (vla-put-ScaleFactor leaderOBJ sc)
- (entdel ldr)
- )
- (defun c:tt()
- (setq p1(getpoint "指定第一点:"))
- (setq ep(getpoint p1 "指定下一点:"))
- (setq Ldr
- (entmakeX
- (list '(0 . "LEADER")
- '(100 . "AcDbEntity")
- '(100 . "AcDbLeader")
- '(40 . 0.9875)
- (cons 10 p1)
- (cons 10 ep)
- '(-3 ("ACAD" (1000 . "DSTYLE") (1002 . "{") (1070 . 40) (1040 . 1) (1070 . 340) (1005 . "139") (1002 . "}")))
- )
- )
- )
-
-
- ;;Mtext
- (setq Mtext
- (entmakeX
- (list '(0 . "MTEXT")
- '(100 . "AcDbEntity")
- '(100 . "AcDbMText")
- '(71 . 7)
- '(72 . 1)
- (cons 1 "111")
- (cons 10 ep)
- )
- )
- )
- (Cq-Ldr&txt ldr mtext)
- (princ)
- )
|