需要Lisp:将节点放置在cen
你好我已经有一段时间没来了。想念你们。我需要询问是否有人有或可以编写一个Lisp例程,将节点放置在图形中多个(100+)圆的中心。我需要一些2D的东西。三维中的高程不是问题。
听起来很简单,但我的同事们都被难住了。
任何帮助都会很棒!
正在运行:
AutoCad 2012和AutoCad MEP 2012
Windows 7 Professional 64位 从上一个线程中解救出来,并进行了一些调整:
;Add Points to Circles (11-VII-2012)
(defun c:APC( / ssetCircles countCircles itemCircle assocCircle assocPoint)
(if (setq ssetCircles (ssget "_X" '((0 . "CIRCLE"))))
(repeat (setq countCircles (sslength ssetCircles))
(setq itemCircle (ssname ssetCircles 0)
assocCircle (entget itemCircle)
assocPoint'((0 . "POINT")))
(foreach codeDXF '(10 8 410 210)
(setq assocPoint (append assocPoint (list (assoc codeDXF assocCircle))))
)
(if (assoc 62 assocCircle)
(setq assocPoint (append assocPoint (list (assoc 62 assocCircle)))))
(if (assoc 6 assocCircle)
(setq assocPoint (append assocPoint (list (assoc 6 assocCircle))))) ;???
(entmakex assocPoint)
(ssdel itemCircle ssetCircles)
)
)
(prompt (strcat "\nReplaced " (itoa countCircles) " circles."))
(princ)
) 大概
(defun c:Test (/ ss)
(if (setq ss (ssget "_x" '((0 . "CIRCLE"))))
((lambda (i / sn e)
(while (setq sn (ssname ss (setq i (1+ i))))
(entmakex (list '(0 . "POINT") (assoc 10 (setq e (entget sn)))(assoc 8 e)))))
-1
)
(princ)
)
(princ)
)
“APC”非常接近。
我使用此命令的情况是在图形中使用圆进行外部参照以表示管道支架。我需要在当前图形中的圆心内放置一个节点,然后拆离外部参照。因此,没有必要替换圆。
也许有一个Lisp来寻找中心,而不是具体的圆。
以下内容适用于具有任何方向、比例或旋转的块/动态块/外部参照:
;; Points at Circle Centres within Block-Lee Mac
;; Prompts for selection of a block and creates points in modelspace
;; at the centre of every circle in the selected block
(defun c:ptcirblk ( / bd en ml )
(while
(progn (setvar 'errno 0) (setq en (car (entsel "\nSelect Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type en))
(if (/= "INSERT" (cdr (assoc 0 (entget en))))
(princ "\nSelected Object is not a Block.")
)
)
)
)
)
(if en
(progn
(setq bd (tblobjname "BLOCK" (cdr (assoc 2 (entget en))))
ml (RefGeom en)
)
(while (setq bd (entnext bd))
(if (= "CIRCLE" (cdr (assoc 0 (entget bd))))
(entmake
(list
'(0 . "POINT")
(cons 10 (mapcar '+ (mxv (car ml) (cdr (assoc 10 (entget bd)))) (cadr ml)))
)
)
)
)
)
)
(princ)
)
;; RefGeom (gile)
;; Returns a list which first item is a 3x3 transformation matrix (rotation,
;; scales, normal) and second item the object insertion point in its parent
;; (xref, block or space)
;;
;; Argument : an ename
(defun RefGeom ( ename / elst ang norm mat )
(setq elst (entget ename)
ang(cdr (assoc 50 elst))
norm (cdr (assoc 210 elst))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 norm t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 elst)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 elst)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 elst)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 elst)) norm 0)
(mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
)
)
)
;; Matrix Transpose-Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Vector-Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Matrix-Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
(princ)
如果有帮助,我正在与TSI看台合作。每个展台周围都有一个圆圈,表示“净空区域”。
如果我分解支架,圆形消失,支架的其余部分变成3d面。
也许这就是为什么李·麦克的Lisp程序不能作画的原因。TSI项不被视为块。
如果我能找到一种从TSI支架中提取该圆的方法,我可以在此线程上使用第一个lisp,或者找到一个可以识别项目中圆的lisp。 也许如果你在第一篇文章中提供了所有必要的信息,我们的时间就不会浪费 我道歉。
我不知道dteails需要有多具体。
令人惊讶的是,简单的概念需要如此详细的解决方案。 那些TSI展台是什么?实体是否特定于MEP? 它们是CADDUT项目。
TSI是一家销售该软件的公司,他们也知道什么时候需要这个lisp工具,但他们想要更多的钱给我们。
所以我希望暂时能找到一份工作。
我想如果我能找到一个lisp,将节点放置在外部参照的CADDUT项的中心,我现在会冷静下来。
页:
[1]
2