如果列表中有很多变量,则第二次使用(第n个lst X)而不是cadr等更容易记住第一次是0而不是1 你说得对,比格尔,当我思考和研究这个问题时,我得出了相同的结论。我真的很感谢你的提示和建议。让他们来! 好吧,它起作用了!但是,我必须说,必须有一种更有效的方法来处理它,代码看起来相当笨拙,有点像“千方百计到达你的肘部”,当然除了李·麦克写的东西。无论如何,这是:
;; 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))
)
;; 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)
)
)
;; 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 circen)
(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)
我想知道我弯曲、拉伸或干脆打破了多少LISP编码定律?
有一件事我改变了我的想法,我要做的是移动这些圆,拉伸奇异地附着在它们上的东西,而不是成对的圆。
再次欢迎您的任何想法、想法或评论!
起草人Joe
页:
1
[2]