谁能换一下这个吗
我有一个lisp，来自Kent Cooper，大约2010年，在每一条相交的直线上输入一个维度。它似乎仅限于在什么样的物体上断裂。我公司的CAD有他们合并的自定义对象，lisp无法将其识别为对象。有谁能稍微改变一下，给所有物体标注尺寸？非常感谢。;;QuickDimAligned.lsp
;;To make a collinear series of Aligned Dimensions along
;;a single fence line, between all intersections of that line
;;with intersectable objects.
;;Kent Cooper, July 2010
;;;;[optional features could be added: account for other
;;;;Coordinate Systems; set layer and/or dimension style]
(defun C:QDA
(/ *error* orth osm blipm dse1 dse2 pt1 pt2 ss obj
intp intc inclist intpt distpt distpts intclist intplist)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort"))
(princ (strcat "\nError: " errmsg))
); end if
(command)
(setvar 'osmode osm)
(setvar 'orthomode orth)
(setvar 'blipmode blipm)
(setvar 'dimse1 dse1)
(setvar 'dimse2 dse2)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
); end defun - *error*
(vl-load-com)
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setq
orth (getvar 'orthomode)
osm (getvar 'osmode)
blipm (getvar 'blipmode)
dse1 (getvar 'dimse1)
dse2 (getvar 'dimse2)
); end setq
(setvar 'orthomode 0)
(setq
pt1 (getpoint "\nStarting Point of QuickDim virtual line: ")
pt2 (getpoint pt1 "\nOther End: ")
ss (ssget "F" (list pt1 pt2) '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY,SOLID,3DFACE,REGION")))
); end setq
(setvar 'osmode 0)
(setvar 'blipmode 0)
(setvar 'dimse1 1)
(setvar 'dimse2 1)
(command "_.line" pt1 pt2 "")
(setq templine (entlast))
(repeat (sslength ss); for each object in selection
(setq
obj (vlax-ename->vla-object (ssname ss 0))
intline (vlax-ename->vla-object templine)
intp (vla-intersectwith obj intline acExtendNone); INTersection Point(s)
intc (safearray-value (variant-value intp)); INTersection Coord's
intclist (append intclist intc); cumulative list for all objects so far
); end setq
(ssdel (ssname ss 0) ss); remove object
); end repeat
(entdel templine)
(repeat (/ (length intclist) 3); number of intersections
(setq
intpt (list (car intclist) (cadr intclist) (caddr intclist)); first remaining point
distpt (cons (distance pt1 intpt) intpt); list: distance followed by point coordinates
distpts (cons distpt distpts); list of those lists
intclist (cdddr intclist); remove first point's coordinates for next one
); end setq
); end repeat
(setq intplist ; list of intersections in order of distance from pt1
(mapcar 'cdr ; strip distances off sorted list
(vl-sort
distpts
'(lambda (p1 p2) (< (car p1) (car p2))); sorted by distance
); end sort
); end mapcar
); end setq
(command "_.dimaligned" (car intplist) (cadr intplist) (cadr intplist))
(setq intplist (cddr intplist)); remove first two points
(while intplist ; as long as there's still another point
(command "_.dimcontinue" (car intplist) "" "")
(setq intplist (cdr intplist))
); end while
(setvar 'osmode osm)
(setvar "orthomode" orth)
(setvar 'blipmode blipm)
(setvar 'dimse1 dse1)
(setvar 'dimse2 dse2)
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); end defun - QDA
(prompt "\nType QDA for QuickDimAligned collinear intersection dimensions.")
(princ)
也可以添加一些东西，这样就有了引线吗？这一部分并不重要，但可以节省清理时间。当它就位时，我执行命令，然后必须添加线以延伸到它们正在标注的对象。我知道有几种方法可以做到这一点，但我总是在寻找最快的做事方式（我想这就是典型的懒惰美国人的态度）。。。似乎总有人想指出一些显而易见的命令，这些命令在技术上可以完成这项工作，但仍然需要很长时间。再次感谢您的帮助。这个论坛总是有一些非常有帮助和聪明的人在做一些我做不到的事情。 嗨，诺布尔，
您希望对哪种自定义对象进行操作？目前，该例程似乎适用于直线、圆弧、圆、椭圆、射线、实体、三维面和区域。虽然我还没有测试过。
仅供参考。。。鉴于这一惯例不是你自己的-论坛上的其他人可能会犹豫修改它（未经作者许可）。我对此并不确定，这可能不是什么问题——只是我发生了一些事情。 我想这是我问题的一部分。我不确定这个物体到底是什么。使用快捷特性时，没有指定为“直线”或“圆”。我想它类似于一条多段线。如果这有任何意义的话，它看起来几乎像一个自定义对象。我使用的命令中有一半不是标准cad。光束和附件命令等。。。这也是我对lisp在这里讲话的无知。我确实看到了代码中对象的主要类型，但我不知道是否有“全对象”代码。
至于改写礼节，作为一个新的lisp世界，我的印象是只要信用是一个主要部分
但如果是这样的话，我会理解的。 允许例程“查看”所有对象（而不是过滤掉一些对象）是可能的。但我不能确定你拥有的物体是否会被接受，从中创建维度。
出于好奇……当你列出你的自定义对象时，你看到了什么？可能会将文本窗口中显示的文本粘贴到此处。 它不是直线或圆弧之类的标准标题，而是结构支撑或沿着这些线的东西。我下周一在办公室的时候会发一张照片。放假去度假。谢谢你的帮助。
页:
[1]