请给我一些帮助-怎么可能
大家好！我为这些例程编写的上一篇文章的标题不再合适。
对于如何使代码更高效，如有任何帮助，我们将不胜感激。例行程序只做他们应该做的。附加的图片应该有助于传达这些例程的功能。
插入块：
通过“缩放”命令将圆的直径更改为与现有圆相同的直径：
通过“拉伸”命令在垂直和水平方向上将圆移动得更近：
;; Test Program-Lee Mac
;;;(defun c:interset ( / sel )
;;; (if (setq sel (ssget))
;;; (foreach pnt (LM:intersectionsinset sel)
;;; (entmake (list '(0 . "POINT") (cons 10 pnt)))
;;; )
;;; )
;;; (princ)
;;
;;;(vl-load-com) (princ)
(defun c:interset (/ sel)
(setvar "cmdecho" 0)
(setq cc1 (ssget "_X" '((0 . "CIRCLE"))))
(command "-insert" "*clover chain.dwg" pause 1 "")
(setq circle (ssname cc1 0))
(setq rad (cdr (assoc 40 (entget circle))))
(setq newrad (/ rad 0.5))
(setq sel (ssget "X" '((0 . "CIRCLE,LINE") (8 . "daisy chain"))))
(LM:intersectionsinset2 sel)
(command "._erase" (ssget "X" '((0 . "LINE") (8 . "daisy chain"))) "")
(setq z 0)
(setq ss (ssget "X" '((0 . "CIRCLE") (8 . "daisy chain"))))
(repeat (sslength ss)
(setq ename (ssname ss z)
circen (cons (list (cdr (assoc 10 (entget ename)))) circen)
z (1+ z)
)
)
(setq circen (reverse circen))
(setq cpt1 (nth 0 (nth 0 circen)))
(setq cpt2 (nth 0 (nth 1 circen)))
(setq cpt3 (nth 0 (nth 2 circen)))
(setq cpt4 (nth 0 (nth 3 circen)))
(setq dist (distance cpt1 cpt2))
(setq stretchdist (/ (- (- dist (* 2 rad)) 1) 2))
(setq cpt1move (strcat "@" (rtos stretchdist) "," (rtos stretchdist)))
(setq cpt2move (strcat "@" (rtos (- stretchdist)) "," (rtos stretchdist)))
(setq cpt3move (strcat "@" (rtos stretchdist) "," (rtos (- stretchdist))))
(setq cpt4move (strcat "@" (rtos (- stretchdist)) "," (rtos (- stretchdist))))
(setq atomx (nth 0 cpt1))
(setq atomy (nth 1 cpt1))
(setq cpt1x (+ (- rad) atomx))
(setq cpt1y (+ (- rad) atomy))
(setq ll (list cpt1x cpt1y))
(setq cpt1x (+ rad atomx))
(setq cpt1y (+ rad atomy))
(setq ur (list cpt1x cpt1y))
(command "stretch" "C" ll ur "" cpt1 cpt1move)
(setq atomx (nth 0 cpt2))
(setq atomy (nth 1 cpt2))
(setq cpt2x (+ (- rad) atomx))
(setq cpt2y (+ (- rad) atomy))
(setq ll (list cpt2x cpt2y))
(setq cpt2x (+ rad atomx))
(setq cpt2y (+ rad atomy))
(setq ur (list cpt2x cpt2y))
(command "stretch" "C" ll ur "" cpt2 cpt2move)
(setq atomx (nth 0 cpt3))
(setq atomy (nth 1 cpt3))
(setq cpt3x (+ (- rad) atomx))
(setq cpt3y (+ (- rad) atomy))
(setq ll (list cpt3x cpt3y))
(setq cpt3x (+ rad atomx))
(setq cpt3y (+ rad atomy))
(setq ur (list cpt3x cpt3y))
(command "stretch" "C" ll ur "" cpt3 cpt3move)
(setq atomx (nth 0 cpt4))
(setq atomy (nth 1 cpt4))
(setq cpt4x (+ (- rad) atomx))
(setq cpt4y (+ (- rad) atomy))
(setq ll (list cpt4x cpt4y))
(setq cpt4x (+ rad atomx))
(setq cpt4y (+ rad atomy))
(setq ur (list cpt4x cpt4y))
(command "stretch" "C" ll ur "" cpt4 cpt4move)
(setvar "cmdecho" 1)
(princ)
)
(vl-load-com)
(princ)
它附带了几个子程序，都是从李的网站上获得的。
;; Intersections-Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - VLA-Objects
;; mod - acextendoption enum of intersectwith method
(defun LM:intersections (ob1 ob2 mod / lst rtn int)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst)
(cadr lst)
(caddr lst)
)
rtn
)
int (vlax-3d-point lst)
)
(vla-ScaleEntity ob1 int newrad)
)
)
还有一个。。。
;; Intersections in Set-Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - Selection Set
(defun LM:intersectionsinset2 (sel / id1 id2 ob1 ob2 rtn)
(repeat (setq id1 (sslength sel))
(setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
(if (= (setq ob1type (vla-get-ObjectName ob1)) "AcDbLine")
(princ)
(progn
(setq sslist (cons (ssname sel id1) sslist))
(repeat (setq id2 id1)
(setq ob2 (vlax-ename->vla-object
(ssname sel (setq id2 (1- id2)))
)
)
(if (= (setq ob2type (vla-get-ObjectName ob2)) "AcDbCircle")
(princ)
(LM:intersections ob1 ob2 acextendnone)
) ;end if
) ;end repeat
) ;progn
) ;end if
) ;end repeat
;(apply 'append (reverse rtn))
)
如果需要任何澄清，请告诉我。
非常感谢。
起草人Joe
（另外，我还想知道在发布帖子时如何使用“标签”以及它们何时合适？） 为什么你从“错误”的区块开始？
你考虑过使用动态块吗？ ... 顺便说一句：似乎两个LM:*函数都已修改。 你好
每次插入块时，圆将需要新的直径，每个直径相同，并且始终距每个边缘1“。
我以前没有使用过动态块，我将研究它们。
非常感谢。 对人们只是“寻找”直线和圆的交点。这加快了调试时间。大套路中的一大块将转移到另一个套路。我只是碰巧开始在那里编码，当时我想我不会添加太多。
谢谢你的提问！
页:
[1]