定位并突出显示特定位置
大家好。我想知道这里有没有海报可以帮忙。我必须提前说，我的lisp技能确实非常有限。
我知道内置的AutoCAD find命令，我可以找到许多可以查找和缩放特定文本的Lisp，但我正在寻找更专用于特定任务的东西。
下面的lisp“LocatePart.lsp”帮助我根据用户输入的文本字符串查找并高亮显示特定块（块名“PartTag”）中特定属性标记（标记名“PART”）的所有实例。
lisp在找到的每个相关属性文本字符串处绘制一个圆环。
这很好，但如果不是在每个找到的点绘制一个甜甜圈，而是从每个找到的属性到原点0,0,0绘制一条线，则更容易看到结果
如果没有lisp知识，我不确定这是否快速简单。
(defun c:LocatePart (/ usrprtnm prtfound enttyp blknm lccosnapm lccentcolr)
(setq lccosnapm(getvar "OSMODE"))
;(setq lccentcolr (getvar "CECOLOR"))
;(setvar "CECOLOR" "1")
(setvar "OSMODE" 0)
(setvar "cmdecho" 0)
(getuserprtnum)
(findprtnm)
;(setvar "CECOLOR" lccentcolr)
(setvar "OSMODE" lccosnapm)
(prin1)
;(setvar "cmdecho" 1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; GETUSERPRTNUM - Get Part number from user
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun getuserprtnum ()
(setq usrprtnm (getstring "\nEnter Partnumber to locate : "))
(while (= "" usrprtnm)
(setq usrprtnm (getstring "\nIncorrect input,
enter again (ctrl-c to exit) : "))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;FINDATT - Find attributes in drawing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun findprtnm ()
(setq ctprblk 0) ;part assembly counter
(setq prtfound 0) ;reset search counter
(setq e (entnext))
(progn (prompt "\nSeraching unit assembly ... ")
(while e
(setq enttyp (cdr (assoc 0 (entget e))))
(setq blknm (cdr (assoc 2 (entget e))))
(if
(and
(equal enttyp "INSERT")
(equal blknm "PartTag")
;(equal (cdr (assoc 66 (entget e))) 1)
) ;and
(updprtnmprop e)
) ;if
(setq e (entnext e))
) ;while
) ;progn
;report search status
(cond ((= prtfound 0)
(princ (strcase usrprtnm))
(princ " NOT found !")
(prin1))
((/= prtfound 0)
(princ prtfound)
(princ " ")
(princ (strcase usrprtnm))
(princ " found")
(prin1))
) ;cond
) ;defun findprtnm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;UPDPRTNMPROP - Compare Part number, change color if found
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun updprtnmprop (e / blkscle insertpt dndia nx ny dnpt)
(setq blkscle (cdr (assoc 41 (entget e))))
;(princ blkscle)
(setq insertpt (cdr (assoc 10 (entget e))))
(while (not (equal (cdr (assoc 0 (entget e))) "SEQEND"))
(if
(and
(equal (cdr (assoc 0 (entget e))) "ATTRIB")
(equal (cdr (assoc 2 (entget e))) "PART")
) ;and
(progn
(setq partnm (strcase (cdr (assoc 1 (entget e)))))
;(princ partnm)
(if (= (strcase usrprtnm) (strcase partnm))
;(princ "\nPart name : ")
;(princ partnm)
(progn
;(princ insertpt)
(setq dnind (* 1.0 (abs blkscle)))
(setq dndia (* 3.5 (abs blkscle)))
(setq ny (cadr insertpt))
(setq ofstx (* (abs blkscle) 6.5))
(setq nx (+ (car insertpt) ofstx))
;(princ nx)
(setq dnpt (list nx ny))
;(princ dndia)
(command "donut" 0dndia dnpt "")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;change color
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(setq ed (entget e))
;; 62 - color property
;(setq ed (subst (cons 62 1) (assoc 62 ed) ed))
;(entmod ed)
;(entupd e)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; counter ++
(setq prtfound (+ prtfound 1))
;(princ prtfound)
) ;progn
) ;if
) ;progn
) ;if
(setq e (entnext e))
) ;while
) ;defun updprtnmprop
我附上图纸“TagSystemExample.dwg”以供参考。
我想我正在尝试实现类似于此lisp的功能，即查找块并绘制到原点的直线，如此处所示：-
http://autocadtips.wordpress.com/2011/12/20/autolisp-find-blocks-mark-them/
如有任何帮助或建议，我们将不胜感激。
标记系统示例。图纸 这适用于文本、多行文字或属性：
(defun c:myfind ( / ent enx inc sel str )
(if (setq sel
(ssget "_X"
(list
'(-4 . "<OR")
'(0 . "TEXT,MTEXT")
'(-4 . "<AND") '(0 . "INSERT") '(66 . 1) '(-4 . "AND>")
'(-4 . "OR>")
(if (= 1 (getvar 'cvport))
(cons 410 (getvar 'ctab))
'(410 . "Model")
)
)
)
)
(if (/= "" (setq str (strcase (getstring t "\nFind What?: "))))
(progn
(repeat (setq inc (sslength sel))
(if (= "INSERT" (cdr (assoc 0 (setq enx (entget (setq ent (ssname sel (setq inc (1- inc)))))))))
(while (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq ent (entnext ent)))))))
(if (= str (strcase (cdr (assoc 1 (reverse enx)))))
(entmake (list '(0 . "LINE") (assoc 10 enx) '(11 0.0 0.0 0.0)))
)
)
(if (= str (strcase (cdr (assoc 1 enx))))
(entmake (list '(0 . "LINE") (assoc 10 enx) '(11 0.0 0.0 0.0)))
)
)
)
)
)
(princ "\nNo Text, MText or Attributes found in this Layout.")
)
(princ)
)
“Find”字符串不区分大小写。 李，你太棒了。
这正是我想要的。
不仅是你的编码能力，而且你如此乐于帮助这里的人们的方式确实令人钦佩。
非常感谢。 谢谢你，马尼拉·沃尔夫，你已经掌握了完成这项任务的大部分代码，但我认为最好提供一个通用的多用途程序；很高兴这有帮助。
页:
[1]