自动编号和长度
嗨，有人能帮我吗？我没有任何关于autolisp的内容，我需要一个例程，可以自动编号，也可以一次性获取多项式的长度。我还需要输入startnumber的可能性。如果可能的话，多段线的数量和长度必须放在多段线的上方和中间。
谢谢 这有帮助吗？
http://www.cadtutor.net/forum/showthread.php?t=35234 嘿，李，谢谢你的Lisp程序。这几乎是我需要的。关于自动编号和对齐，这很完美，但我仍然忽略了多段线的长度。
有关更多信息，请参阅图片。
再次感谢您的帮助。
http://www.sablex.be/polyNumLen.JPG 试一试，它使用字段：
(defun c:PLen ( / *error* doc spc ent uFlag tStr )
(vl-load-com)
;; Lee Mac~21.04.10
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object))
spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)))
(setq *num (cond ( *num ) ( 1 ))
*num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
(*num))))
(while (setq ent (CurveifFoo (lambda (ent)
(and (isCurveObject ent)
(vlax-property-available-p
(vlax-ename->vla-object ent) 'Length)))
(strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))
(setq uFlag (not (vla-StartUndoMark doc))
tStr(strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID (vlax-ename->vla-object ent)) ">%).Length \\f \"%lu6\>%"))
(AlignObjtoCurve
(MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))
(setq uFlag (vla-EndUndoMark doc)))
(princ))
(defun GetObjectID ( obj )
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility
(vla-get-ActiveDocument
(vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))))
(defun MCMText (block point width string / o)
(vla-put-AttachmentPoint
(setq o (vla-AddMText block
(vlax-3D-point point) width string))
acAttachmentPointMiddleCenter)
o)
(defun isCurveObject (ent)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getEndParam) (list ent)))))
(defun CurveifFoo ( foo str / sel ent )
(while
(progn
(setq sel (entsel str))
(cond ((vl-consp sel)
(if (not (foo (setq ent (car sel))))
(princ "\n** Invalid Object Selected **"))))))
ent)
(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
(vl-load-com)
(defun *error* (msg)
(and obj (not (vlax-erased-p obj)) (vla-delete obj))
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
(or *Mac$Off* (setq *Mac$Off* 1.))
(setq msg(princ "\n<< [+/-] for offset, erpendicularity toggle >>"))
(while
(progn
(setq gr (grread 't 15 0) code (car gr) data (cadr gr))
(cond ((and (= 5 code) (listp data))
(setq pt (vlax-curve-getClosestPointto ent data)
cAng (angle pt data)
lAng (+ cAng *Mac$Per*))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(vla-put-InsertionPoint Obj
(vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
(vla-put-Rotation Obj lAng)
t)
((= 2 code)
(cond ((vl-position data '(43 61))
(setq *Mac$Off* (+ *Mac$Off* 0.1)))
((= 45 data)
(setq *Mac$Off* (- *Mac$Off* 0.1)))
((vl-position data '(80 112))
(setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
((vl-position data '(13 32))
(setq Obj nil))
(t )))
((and (= 3 code) (listp data))
(setq pt (vlax-curve-getClosestPointto ent data)
cAng (angle pt data)
lAng (+ cAng *Mac$Per*))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(vla-put-InsertionPoint Obj
(vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
(vla-put-Rotation Obj lAng)
(setq Obj nil))
((= 25 code) (setq Obj nil))
(t ))))
data)
更新为包括圆和圆弧
(defun c:PLab (/ obj)
;; Label each LWPolyline segment with number and distance
;; Alan J. Thompson, 04.21.10
(if (and (setq obj (car (entsel "\nSelect LWPolyline: ")))
(or (eq "LWPOLYLINE" (cdr (assoc 0 (entget obj))))
(alert "Invalid object!")
)
(setq obj (vlax-ename->vla-object obj))
)
((lambda (n l / a b)
(while (nth (1+ (setq n (1+ n))) l)
(progn
(vla-put-rotation
(AT:MText (vlax-3d-point
(vlax-curve-GetClosestPointTo
obj
(mapcar (function (lambda (x y) (/ (+ x y) 2.)))
(setq a (nth n l))
(setq b (nth (1+ n) l))
)
)
)
(strcat (itoa (1+ n))
" - "
(rtos (abs (- (vlax-curve-getDistAtPoint obj a)
(vlax-curve-getDistAtPoint obj b)
)
)
)
)
0.
nil
8
)
(angle a b)
)
)
)
)
-1
(AT:ListGroupByNumber (vlax-get obj 'Coordinates) 2)
)
)
(princ)
)
;;; Add MText to drawing
;;; Pt - MText insertion point
;;; Str - String to place in created MText object
;;; Wd - Width of MText object (if nil, will be 0 width)
;;; Lay - Layer to place Mtext object on (nil for current)
;;; Jus - Justification # for Mtext object
;;; 1 or nil= TopLeft
;;; 2= TopCenter
;;; 3= TopRight
;;; 4= MiddleLeft
;;; 5= MiddleCenter
;;; 6= MiddleRight
;;; 7= BottomLeft
;;; 8= BottomCenter
;;; 9= BottomRight
;;; Alan J. Thompson, 05.23.09 / 04.09.10
(defun AT:MText (Pt Str Wd Lay Jus / Wd s o)
(or Wd (setq Wd 0.))
(setq s(if (or (eq acmodelspace
(vla-get-activespace
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
)
(eq :vlax-true (vla-get-mspace *AcadDoc*))
)
(vla-get-modelspace *AcadDoc*)
(vla-get-paperspace *AcadDoc*)
)
Pt (cond ((vl-consp Pt) (vlax-3d-point Pt))
((eq (type Pt) 'variant) Pt)
)
)
(setq o (vla-addMText s Pt Wd (vl-princ-to-string Str)))
(and Lay (tblsearch "layer" Lay) (vla-put-layer o Lay))
(cond ((vl-position Jus '(1 2 3 4 5 6 7 8 9))
(vla-put-AttachmentPoint o Jus)
(vla-put-InsertionPoint o Pt)
)
)
o
)
;;; Group items in list based on specified number
;;; L - List to process
;;; # - Number of items for grouping
;;; Alan J. Thompson, 03.26.10
(defun AT:ListGroupByNumber (L # / n g f)
(setq n -1)
(while (> (1- (length L)) n)
(repeat # (setq g (cons (nth (setq n (1+ n)) L) g)))
(setq f (cons (reverse g) f)
g nil
) ;_ setq
) ;_ while
(reverse f)
) ;_ defun 我想艾伦疯了 爆笑
我确实让他们有点失控了。自从你按照MP的代码做了那个边界框例程之后，除了使用mapcar（或者像我所知道的那样定义函数）之外，我一直像个疯子一样喜欢和滥用lambda。
我是说，看看这个：
(defun c:PLen ( / *error* doc spc ent obj uFlag tStr )
(vl-load-com)
;; Lee Mac~21.04.10
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(setq doc (vla-get-ActiveDocument
(vlax-get-acad-object))
spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
(vla-get-ModelSpace doc)
(vla-get-PaperSpace doc)))
(setq *num (cond ( *num ) ( 1 ))
*num (1- (cond ((getint (strcat "\nSpecify Starting Number <" (itoa *num) "> : ")))
(*num))))
(while (setq ent (CurveifFoo (lambda (ent)
(and (isCurveObject ent)
(vl-some
(function
(lambda ( property )
(vlax-property-available-p
(vlax-ename->vla-object ent) property)))
'(Length ArcLength Circumference))))
(strcat "\nSelect Curve Number [" (itoa (setq *num (1+ *num))) "] : ")))
(setq uFlag (not (vla-StartUndoMark doc))
tStr(strcat (itoa *num) "- %<\\AcObjProp Object(%<\\_ObjId "
(GetObjectID (setq obj (vlax-ename->vla-object ent))) ">%)."
(vl-some
(function
(lambda ( property )
(if (vlax-property-available-p obj (read property)) property)))
'("Length" "ArcLength" "Circumference")) " \\f \"%lu6\>%"))
(AlignObjtoCurve
(MCMText spc (getvar 'VIEWCTR) 0. tStr) ent (getvar 'TEXTSIZE))
(setq uFlag (vla-EndUndoMark doc)))
(princ))
(defun GetObjectID ( obj )
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility
(vla-get-ActiveDocument
(vlax-get-acad-object))) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))))
(defun MCMText (block point width string / o)
(vla-put-AttachmentPoint
(setq o (vla-AddMText block
(vlax-3D-point point) width string))
acAttachmentPointMiddleCenter)
o)
(defun isCurveObject (ent)
(not
(vl-catch-all-error-p
(vl-catch-all-apply
(function vlax-curve-getEndParam) (list ent)))))
(defun CurveifFoo ( foo str / sel ent )
(while
(progn
(setq sel (entsel str))
(cond ((vl-consp sel)
(if (not (foo (setq ent (car sel))))
(princ "\n** Invalid Object Selected **"))))))
ent)
(defun AlignObjToCurve ( obj ent o / *error* msg gr code data pt cAng lAng )
(vl-load-com)
(defun *error* (msg)
(and obj (not (vlax-erased-p obj)) (vla-delete obj))
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(or *Mac$Per* (setq *Mac$Per* (/ pi 2.)))
(or *Mac$Off* (setq *Mac$Off* 1.))
(setq msg(princ "\n<< [+/-] for offset, erpendicularity toggle >>"))
(while
(progn
(setq gr (grread 't 15 0) code (car gr) data (cadr gr))
(cond ((and (= 5 code) (listp data))
(setq pt (vlax-curve-getClosestPointto ent data)
cAng (angle pt data)
lAng (+ cAng *Mac$Per*))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(vla-put-InsertionPoint Obj
(vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
(vla-put-Rotation Obj lAng)
t)
((= 2 code)
(cond ((vl-position data '(43 61))
(setq *Mac$Off* (+ *Mac$Off* 0.1)))
((= 45 data)
(setq *Mac$Off* (- *Mac$Off* 0.1)))
((vl-position data '(80 112))
(setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
((vl-position data '(13 32))
(setq Obj nil))
(t )))
((and (= 3 code) (listp data))
(setq pt (vlax-curve-getClosestPointto ent data)
cAng (angle pt data)
lAng (+ cAng *Mac$Per*))
(cond ((and (> lAng (/ pi 2)) (<= lAng pi))
(setq lAng (- lAng pi)))
((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
(setq lAng (+ lAng pi))))
(vla-put-InsertionPoint Obj
(vlax-3D-point (polar pt cAng (* o *Mac$Off*))))
(vla-put-Rotation Obj lAng)
(setq Obj nil))
((= 25 code) (setq Obj nil))
(t ))))
data)
5λ表达式
你知道，我很惊讶你没有评论我放弃了结束行注释和变量赋值。
顺便说一句：我的三角测试（最后一个星期一）得了96分，其中2分被取消了，因为我忘了在一个问题上表示我的单位。如果你没有回答我的问题，我会完全迷失在那一部分。谢谢。
别担心，伙计，很高兴你一切顺利 李Mac的普兰lisp工程伟大的什么我想要的，但有可能有一个将。。。
[列表=1]
[*]不进行自动编号。
[*]总长度值自动插入到多段线的中心/中点。
在查找每条多段线的长度时，我希望加快速度。如果可能的话，我希望能够选择所有多段线，并让所有值自动插入到每个单独的多段线上。
再次感谢，希望不要要求太多。 嗨，戈登，
试一试，让我知道你（使用场）进展如何，
（defunc:PlL（（）；；李Mac ~ 29.04.10（defun（msg（（（“*中断，*取消*，*退出*”（princ]”**“）（princ（setqspc（如果（eqb](vla get ActiveSpace（setqdoc（）（）（eq（doc color]）vla get模型空间doc（vla get纸张空间doc（b]-1ss（ssget（0“线，*折线”（而（setqe（ssnamess（i）[（setqDer（angle0。0。0。（]vlax曲线getFirstDerive（vlax曲线getParamatPointe（setqp（中点e]]]]（setq（MCMText spc（p（（/2。(getvarTEXTSIZE0。（strcat“%”。长度\\f \“%lu6 \”>%“（colorvla put rotationObj（MakeReadable DerprincdefunMCMText b]/o（vla放置附着点（setqo（块（acAttachmentPointMiddleCenter（vla放置插入点o（点）o（[/颜色defun使可读（a）（（（（a（[pi2 （api（
页:
[1]
2