社区 › AutoLISP/Visual LISP 编程技术 › 【e派】工具箱函数再揭秘及应用实例

xyp1964 发表于 2012-8-5 19:57:04

本帖最后由 xyp1964 于 2017-11-20 22:00 编辑


;; xyp-ScaleEntity 缩放实体或选择集 (xyp-ScaleEntity ename point sc)
(defun xyp-ScaleEntity (ename point sc / tp pt i s1 x)
(setq tp (type ename)
pt (vlax-3D-point (trans point 1 0))
)
(cond ((= tp 'ENAME) (vla-scaleentity (xyp-e2o ename) pt sc))
((= tp 'PICKSET)
    (setq i -1)
    (while (setq s1 (ssname ename (setq i (1+ i))))
      (vla-scaleentity (xyp-e2o s1) pt sc)
    )
)
((= tp 'LIST) (foreach x (xyp-ScaleEntity x point sc)))
)
ename
)

;; 应用实例2: 柱子缩放
(defun c:tt2 ()
(CMDLA0)
(setq ss (ssget '((0 . "LWPOLYLINE") (8 . "柱")))
l1 '((0 . "Line") (8 . "轴线"))
l2 '((0 . "DIMENSION") (8 . "COLUMN-平法定位"))
i-1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
    (setq p1 (xyp-get-9pt s1 1)
   p1 (xyp-get-Pt2XY p1 -200 -200)
   p9 (xyp-get-9pt s1 9)
   p9 (xyp-get-Pt2XY p9 200 200)
    )
    (if (and (setq ss1 (ssget "c" p1 p9 l1))
      (= (sslength ss1) 2)
)
      (progn
(setq s2(ssname ss1 0)
       s3(ssname ss1 1)
       pt(car (xyp-get-Inters s2 s3 0))
       ss2 (ssget "c" p1 p9 l2)
       ss2(ssadd s1 ss2)
)
(xyp-ScaleEntity ss2 pt 0.5)
(command"dim" "upd" ss2 "" "e")
      )
    )
)
(CMDLA1)
)

随梦而飞 发表于 2012-8-5 21:10:13

十分强大，太好了，作用巨大

xyp1964 发表于 2012-8-5 22:03:02

柱子缩放扩展

xiaxiang 发表于 2012-8-6 08:38:43

再次坐享其成,感谢院长坚持不懈的分享

xyp1964 发表于 2012-8-6 09:37:46

本帖最后由 xyp1964 于 2012-8-6 09:38 编辑

xiaxiang 发表于 2012-8-6 08:38 http://bbs.mjtd.com/static/image/common/back.gif
再次坐享其成,感谢院长坚持不懈的分享

把已经发布的代码完整地整理一下？

xiaxiang 发表于 2012-8-6 09:40:31

本帖最后由 xiaxiang 于 2013-1-8 08:30 编辑

xyp1964 发表于 2012-8-6 09:37 http://bbs.mjtd.com/static/image/common/back.gif
把已经发布的代码完整地整理一下？

除了伪代码以外

xyp1964 发表于 2012-8-7 15:13:54

本帖最后由 xyp1964 于 2017-11-20 22:01 编辑


;; xyp-CircleLineDim 圆轴线标注 (xyp-CircleLineDim s1 dx dy)
(defun xyp-CircleLineDim (s1 dx dy / p1 p9 p0 ss2 s2 s3 s4 p11 p22)
(setq p1 (xyp-get-9pt s1 1)
p1 (xyp-get-Pt2XY p1 (- dx) (- dy))
p9 (xyp-get-9pt s1 9)
p9 (xyp-get-Pt2XY p9 dx dy)
p0 (xyp-get-dxf 10 s1)
)
(if (and (setq ss2 (ssget "c" p1 p9 '((0 . "line"))))
    (= (sslength ss2) 2)
      )
    (progn
      (setq s3 (ssname ss2 0)
   s4 (ssname ss2 1)
      )
      (if (xyp-get-Inters s3 s4 3)
(progn
   (setq p11 (xyp-PerpendicularFoot-Pt2Line p0 s3)
p22 (xyp-PerpendicularFoot-Pt2Line p0 s4)
   )
   (if (> (distance p0 p11) 0)
   (xyp-Dim-Ali p0 p11 600)
   )
   (if (> (distance p0 p22) 0)
   (xyp-Dim-Ali p0 p22 600)
   )
)
      )
    )
)
)
;; 实例：圆轴标注

YYHappy1314 发表于 2012-8-7 15:58:21

支持，顶~，好好学习

仲文玉 发表于 2012-8-7 21:49:30

什么都不说，支持

xsso 发表于 2012-8-7 23:26:50

继续收藏！

查看完整版本: 【e派】工具箱函数再揭秘及应用实例