明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 590|回复: 2

[资源] 尺寸定点伸缩!

[复制链接]
发表于 2019-4-18 20:42 | 显示全部楼层 |阅读模式
  • (vl-load-com)
  • (defun c:dimension-ExtLinePoint-algin_beyondutmost (/ a dividepoint
  •                                                       extline1point1
  •                                                       extline1point2
  •                                                       extline2point1
  •                                                       extline2point2 j n
  •                                                       perpoint ss sslen
  •                                                    )
  •   (if (and
  •         (setq ss (ssget '((0 . "DIMENSION"))))
  •         (> (setq sslen (sslength ss))
  •            1
  •         )
  •       )
  •     (progn
  •       (setq dividepoint (getpoint "\nPick the alginment point:"))
  •       (setq n 0)
  •       (while (< n (1- sslen))
  •         (setq j (1+ n))
  •         (while (< j sslen)
  •           (setq ExtLine1Point1 (cdr (assoc 13 (entget (ssname ss n))))
  •                 ExtLine2Point1 (cdr (assoc 14 (entget (ssname ss n))))
  •                 ExtLine1Point2 (cdr (assoc 13 (entget (ssname ss j))))
  •                 ExtLine2Point2 (cdr (assoc 14 (entget (ssname ss j))))
  •           )
  •           (if (< (distance ExtLine1Point1 ExtLine1Point2) 0.1)
  •             (progn
  •               (setq a (mapcar
  •                         '-
  •                         ExtLine1Point1
  •                         ExtLine2Point1
  •                       )
  •               )
  •               (setq perpoint (inters
  •                                (mapcar
  •                                  '+
  •                                  (list (- (cadr a)) (car a) (caddr a))
  •                                  dividepoint
  •                                )
  •                                dividepoint
  •                                ExtLine1Point1
  •                                ExtLine2Point1
  •                                nil
  •                              )
  •               )
  •               (entmod (subst
  •                         (cons 13 perpoint)
  •                         (assoc 13 (entget (ssname ss n)))
  •                         (entget (ssname ss n))
  •                       )
  •               )
  •               (entmod (subst
  •                         (cons 13 perpoint)
  •                         (assoc 13 (entget (ssname ss j)))
  •                         (entget (ssname ss j))
  •                       )
  •               )
  •             )
  •           )
  •           (if (< (distance ExtLine1Point1 ExtLine2Point2) 0.1)
  •             (progn
  •               (setq a (mapcar
  •                         '-
  •                         ExtLine1Point1
  •                         ExtLine2Point1
  •                       )
  •               )
  •               (setq perpoint (inters
  •                                (mapcar
  •                                  '+
  •                                  (list (- (cadr a)) (car a) (caddr a))
  •                                  dividepoint
  •                                )
  •                                dividepoint
  •                                ExtLine1Point1
  •                                ExtLine2Point1
  •                                nil
  •                              )
  •               )
  •               (entmod (subst
  •                         (cons 13 perpoint)
  •                         (assoc 13 (entget (ssname ss n)))
  •                         (entget (ssname ss n))
  •                       )
  •               )
  •               (entmod (subst
  •                         (cons 14 perpoint)
  •                         (assoc 14 (entget (ssname ss j)))
  •                         (entget (ssname ss j))
  •                       )
  •               )
  •             )
  •           )
  •           (if (< (distance ExtLine2Point1 ExtLine1Point2) 0.1)
  •             (progn
  •               (setq a (mapcar
  •                         '-
  •                         ExtLine1Point1
  •                         ExtLine2Point1
  •                       )
  •               )
  •               (setq perpoint (inters
  •                                (mapcar
  •                                  '+
  •                                  (list (- (cadr a)) (car a) (caddr a))
  •                                  dividepoint
  •                                )
  •                                dividepoint
  •                                ExtLine1Point1
  •                                ExtLine2Point1
  •                                nil
  •                              )
  •               )
  •               (entmod (subst
  •                         (cons 14 perpoint)
  •                         (assoc 14 (entget (ssname ss n)))
  •                         (entget (ssname ss n))
  •                       )
  •               )
  •               (entmod (subst
  •                         (cons 13 perpoint)
  •                         (assoc 13 (entget (ssname ss j)))
  •                         (entget (ssname ss j))
  •                       )
  •               )
  •             )
  •           )
  •           (if (< (distance ExtLine2Point1 ExtLine2Point2) 0.1)
  •             (progn
  •               (setq a (mapcar
  •                         '-
  •                         ExtLine1Point1
  •                         ExtLine2Point1
  •                       )
  •               )
  •               (setq perpoint (inters
  •                                (mapcar
  •                                  '+
  •                                  (list (- (cadr a)) (car a) (caddr a))
  •                                  dividepoint
  •                                )
  •                                dividepoint
  •                                ExtLine1Point1
  •                                ExtLine2Point1
  •                                nil
  •                              )
  •               )
  •               (entmod (subst
  •                         (cons 14 perpoint)
  •                         (assoc 14 (entget (ssname ss n)))
  •                         (entget (ssname ss n))
  •                       )
  •               )
  •               (entmod (subst
  •                         (cons 14 perpoint)
  •                         (assoc 14 (entget (ssname ss j)))
  •                         (entget (ssname ss j))
  •                       )
  •               )
  •             )
  •           )
  •           (setq j (1+ j))
  •         )
  •         (setq n (1+ n))
  •       )
  •     )
  •     (progn
  •       (setq dividepoint (getpoint "\nPick the alginment point:"))
  •       (setq ExtLine1Point1 (cdr (assoc 13 (entget (ssname ss 0))))
  •             ExtLine2Point1 (cdr (assoc 14 (entget (ssname ss 0))))
  •       )
  •       (setq a (mapcar
  •                 '-
  •                 ExtLine1Point1
  •                 ExtLine2Point1
  •               )
  •       )
  •       (setq perpoint (inters
  •                        (mapcar
  •                          '+
  •                          (list (- (cadr a)) (car a) (caddr a))
  •                          dividepoint
  •                        )
  •                        dividepoint
  •                        ExtLine1Point1
  •                        ExtLine2Point1
  •                        nil
  •                      )
  •       )
  •       (if (<= (distance ExtLine1Point1 perpoint) (distance ExtLine2Point1
  •                                                            perpoint
  •                                                  )
  •           )
  •         (entmod (subst
  •                   (cons 13 perpoint)
  •                   (assoc 13 (entget (ssname ss 0)))
  •                   (entget (ssname ss 0))
  •                 )
  •         )
  •         (entmod (subst
  •                   (cons 14 perpoint)
  •                   (assoc 14 (entget (ssname ss 0)))
  •                   (entget (ssname ss 0))
  •                 )
  •         )
  •       )
  •     )
  •   )
  •   (princ)
  • )
  • 出处:http://www.tigerspace.net/bbs/fo ... &extra=page%3D1
  • 感谢原作者,找了好久的,海龙软件少了这个东西就不好用了!

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2019-4-19 09:28 | 显示全部楼层
谢谢! 小毛草 分享程序!!!!!
发表于 2019-12-10 19:48 | 显示全部楼层
请问怎么用啊?怎么唤起这命令??
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 17:06 , Processed in 0.273683 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表