自动编号和长度

woohhoo · 发表于 2022-7-5 18:32:42

嗨，有人能帮我吗？我没有任何关于autolisp的内容，我需要一个例程，可以自动编号，也可以一次性获取多项式的长度。我还需要输入startnumber的可能性。
如果可能的话，多段线的数量和长度必须放在多段线的上方和中间。
谢谢

Lee Mac · 发表于 2022-7-5 18:38:02

这有帮助吗？

http://www.cadtutor.net/forum/showthread.php?t=35234

woohhoo · 发表于 2022-7-5 18:39:51

嘿，李，谢谢你的Lisp程序。这几乎是我需要的。关于自动编号和对齐，这很完美，但我仍然忽略了多段线的长度。
有关更多信息，请参阅图片。
再次感谢您的帮助。

登录/注册后可看大图

Lee Mac · 发表于 2022-7-5 18:45:27

试一试，它使用字段：

copy


(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, [P]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)

stevesfr · 发表于 2022-7-5 18:49:36

更新为包括圆和圆弧

copy

(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

Lee Mac · 发表于 2022-7-5 18:52:53

我想艾伦疯了

alanjt · 发表于 2022-7-5 18:57:10

爆笑
我确实让他们有点失控了。自从你按照MP的代码做了那个边界框例程之后，除了使用mapcar（或者像我所知道的那样定义函数）之外，我一直像个疯子一样喜欢和滥用lambda。

我是说，看看这个：

copy


(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, [P]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分被取消了，因为我忘了在一个问题上表示我的单位。如果你没有回答我的问题，我会完全迷失在那一部分。谢谢。

Lee Mac · 发表于 2022-7-5 18:58:47

别担心，伙计，很高兴你一切顺利

alanjt · 发表于 2022-7-5 19:01:34

李Mac的普兰lisp工程伟大的什么我想要的，但有可能有一个将。。。
[列表=1]

不进行自动编号。

总长度值自动插入到多段线的中心/中点。
在查找每条多段线的长度时，我希望加快速度。如果可能的话，我希望能够选择所有多段线，并让所有值自动插入到每个单独的多段线上。

再次感谢，希望不要要求太多。

Lee Mac · 发表于 2022-7-5 19:06:31

嗨，戈登，

试一试，让我知道你（使用场）进展如何，

[code]（defunc:PlL（（[color=BLUE vl load com][color b]）；；李Mac ~ 29.04.10（defun（msg（[color=BLUE b]（[/color b][color=BLUE wcmatch][color b]（[/color b][color=BLUE b]“*中断，*取消*，*退出*”（princ][color][color=BLUE strcat][color][n**错误：“[/color b][msg”**“）（princ（setq[color]spc（如果[color][color=RED或[color]（eq[color]b][color][color=红色](vla get ActiveSpace（setqdoc（[color=BLUE vla get ACTIVESTACT）（[color=BLUE b]）（eq（[color=BLUE vla get MSpacedoc color]）[/colorvla get模型空间[color]doc（vla get纸张空间[color]doc[color=BLUE if[color b]（[/color b][color=BLUE b]b]-1[color]ss（ssget（0“线，*折线”[color]（而[color]（setq[color]e（ssname[color]ss（[color=BLUE 1+/color]i）[（setqDer（angle0。0。0。（[color=BLUE b]]vlax曲线getFirstDerive（vlax曲线getParamatPointe（setqp（中点e]]]]（setq[color]（MCMText spc（p（（/[color=BLUE pi][color][color=BLUE pi][009999]2。[/color b](getvarTEXTSIZE0。（strcat“%”。长度\\f \“%lu6 \”>%“[/color b]（[/color=RED]colorvla put rotation[/colorObj（MakeReadable Derprinc[color=RED b][color=REDdefunMCMText b][color=RED点宽度字符串/o（vla放置附着点[color]（setq[color]o[color]（[color=BLUE vla AddMText color]块（[/color b][color=BLUE BLUE vlax-3D-point b]acAttachmentPointMiddleCenter（vla放置插入点[color]o（[color=Blue vlax-3D点[color b]点）o（[/颜色defun[color]使可读（a）（（（[color=BLUE b]（[color=BLUE>[/color b]a（[color=BLUE b][pi[color]2[color] （[color]api[color]（[/color[color=BLUE b]

[编程交流] 自动编号和长度

发表回复

精选推荐