修改Lisp

feargt · 发表于 2022-7-6 14:30:57

你好

我有一个lisp例程，我们在办公室使用它来标记具有全局宽度的多段线。
即，如果我有一条全局宽度为0.2的多段线（代表管道），例程将用DN200标记多段线的所有段

我想做的是更改此代码，以便如果多段线段小于10个单位，则此段不会得到标签。

例如，长度为29个单位的多段线有3段，2段的长度为12个单位，第三段的长度为5个单位。
我希望标记12个单元的2个段，但不要标记5个单元的第三个段

_________________

如果没有线段大于10个单位，则在中点标记一次多段线。

______________

这里我的第一个问题是，我不确定我需要在代码中的什么地方进行更改。

如果有人能帮助我或给我举一些例子说明如何实现这一点，我将不胜感激。

谢谢

copy

 
                                ;This routine was provided by ASMI.
(vl-load-com)
(defun c:Label_Width (/              js      htx     AcDoc   cLay    Space
              nw_style              obj     dxf_ent ename   t_mod
              key     pr      t_char  js_text pt      deriv
              rtx     nw_obj  n
             )
 (princ "\nSelect a polyline.")
 (while
   (null
     (setq js
     (ssget "_+.:E:S"
            (list
              '(0 . "*POLYLINE")
              (cons 67
                    (if        (eq (getvar "CVPORT") 1)
                      1
                      0
                    )
              )
              (cons 410
                    (if        (eq (getvar "CVPORT") 1)
                      (getvar "CTAB")
                      "Model"
                    )
              )
            )
     )
     )
   )
    (princ "\nIsn't an available object for this fonction!")
 )
 (setq
   obj            (ssname js 0)
   dxf_ent (entget obj)
   ename   (vlax-ename->vla-object obj)
   cLay    (vla-get-Layer ename)
   t_mod   '+
   key            "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space
     (if (= 1 (getvar "CVPORT"))
       (vla-get-PaperSpace AcDoc)
       (vla-get-ModelSpace AcDoc)
     )
    )
    (repeat 2
      (setq pr             -0.5
     t_char  64
     js_text (ssadd)
      )
      (if (eq key "Yes")
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     pt           (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
     deriv (vlax-curve-getFirstDeriv ename pr)
     rtx   (- (atan (cadr deriv) (car deriv))
              (angle '(0 0 0) (getvar "UCSXDIR"))
           )
   )
   (setq nw_obj
          (vla-addMtext
            Space
            (vlax-3d-point
              (setq pt (polar pt
                              ((eval t_mod) rtx (* pi 0.5))
                              (getvar "TEXTSIZE")
                       )
              )
            )
            0.0
            (strcat
              "DN"
              "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
              (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
              ">%).ConstantWidth >% * 1000) \\f "%lu2%pr0">%"
            )
          )
   )
   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
     (setq rtx (+ rtx pi))
   )
   (mapcar
     '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
     (list 'AttachmentPoint   'Height
           'DrawingDirection  'InsertionPoint
           'StyleName              'Layer
           'Rotation
          )
     (list 5
           (getvar "TEXTSIZE")
           5
           pt
           (getvar "TEXTSTYLE")
           cLay
           rtx
     )
   )
   (ssadd (entlast) js_text)
 )
      )
      (if (not (eq t_mod '-))
 (progn
   (initget "Yes No")
   (if (eq (setq
             key (getkword
                   "\nPut labels on other side [Yes/No]? <No>: "
                 )
           )
           "Yes"
       )
     (progn (setq n -1
                  t_mod        '-
            )
            (repeat (sslength js_text)
              (entdel (ssname js_text (setq n (1+ n))))
            )
     )
     (setq t_mod '-)
   )
 )
      )
    )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
 (prin1)
)

feargt · 发表于 2022-7-6 14:39:41

有人有什么想法吗？

CAB · 发表于 2022-7-6 14:45:10

试试这个：

copy

;;This routine was provided by ASMI.
(vl-load-com)
(defun c:Label_Width (/              js      htx     AcDoc   cLay    Space
              nw_style              obj     dxf_ent ename   t_mod
              key     pr      t_char  js_text pt      deriv
              rtx     nw_obj  n  par  len
             )
 (princ "\nSelect a polyline.")
 (while
   (null
     (setq js
     (ssget "_+.:E:S"
            (list
              '(0 . "*POLYLINE")
              (cons 67
                    (if        (eq (getvar "CVPORT") 1)
                      1
                      0
                    )
              )
              (cons 410
                    (if        (eq (getvar "CVPORT") 1)
                      (getvar "CTAB")
                      "Model"
                    )
              )
            )
     )
     )
   )
    (princ "\nIsn't an available object for this fonction!")
 )
 (setq
   obj            (ssname js 0)
   dxf_ent (entget obj)
   ename   (vlax-ename->vla-object obj)
   cLay    (vla-get-Layer ename)
   t_mod   '+
   key            "Yes"
 )
 (cond
   ((assoc 43 dxf_ent)
    (setq
      AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
      Space
     (if (= 1 (getvar "CVPORT"))
       (vla-get-PaperSpace AcDoc)
       (vla-get-ModelSpace AcDoc)
     )
    )
    (repeat 2
      (setq pr             -0.5
     t_char  64
     js_text (ssadd)
      )
      (if (eq key "Yes")
 (repeat (fix (vlax-curve-getEndParam ename))
   (setq
     pt           (vlax-curve-GetpointAtParam ename (setq pr (1+ pr)))
     deriv (vlax-curve-getFirstDeriv ename pr)
     rtx   (- (atan (cadr deriv) (car deriv))
              (angle '(0 0 0) (getvar "UCSXDIR"))
           )
   )
          ;;  Test for segment length - CAB
          ;;  vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
          (setq par (fix pr))
          (if (= par (fix (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (vlax-curve-getEndParam ename)))
            (setq len (vlax-curve-getdistatparam ename (1+ par)))
          )
          (setq len (- len (vlax-curve-getdistatparam ename par)))
                
          (if (> len 10.0) ; Min Segment Length
            (progn
          ;;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
   (setq nw_obj
          (vla-addMtext
            Space
            (vlax-3d-point
              (setq pt (polar pt
                              ((eval t_mod) rtx (* pi 0.5))
                              (getvar "TEXTSIZE")
                       )
              )
            )
            0.0
            (strcat
              "DN"
              "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
              (itoa (vla-get-ObjectID (vlax-ename->vla-object obj)))
              ">%).ConstantWidth >% * 1000) \\f "%lu2%pr0">%"
            )
          )
   )
   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
     (setq rtx (+ rtx pi))
   )
   (mapcar
     '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
     (list 'AttachmentPoint   'Height
           'DrawingDirection  'InsertionPoint
           'StyleName              'Layer
           'Rotation
          )
     (list 5
           (getvar "TEXTSIZE")
           5
           pt
           (getvar "TEXTSTYLE")
           cLay
           rtx
     )
   )
   (ssadd (entlast) js_text)
          ) ; CAB
            ) ; CAB
 )
      )
      (if (not (eq t_mod '-))
 (progn
   (initget "Yes No")
   (if (eq (setq
             key (getkword
                   "\nPut labels on other side [Yes/No]? <No>: "
                 )
           )
           "Yes"
       )
     (progn (setq n -1
                  t_mod        '-
            )
            (repeat (sslength js_text)
              (entdel (ssname js_text (setq n (1+ n))))
            )
     )
     (setq t_mod '-)
   )
 )
      )
    )
   )
   (T (princ "\nThis polyine does not have a constant width!"))
 )
 (prin1)
)

ronjonp · 发表于 2022-7-6 14:52:35

这似乎对我有效*又太慢了

*将翻转标签更改为拾取点。。输入结束。

copy


;This routine was provided by ASMI.
; Additions by RJP 05-29-2009
(defun c:label_width (/      acdoc  clay   d      deriv  dxf_ent       ename  flag   js     js_text
                     key    nw_obj obj    out    p      pr     pt     pt2    rtx    space  t_char
                     t_mod  val    x      w
                    )
 (vl-load-com)
 (princ "\nSelect a polyline.")
 (while (null (setq js (ssget "_+.:E:S"
                              (list '(0 . "*POLYLINE")
                                    (cons 67
                                          (if (eq (getvar "CVPORT") 1)
                                            1
                                            0
                                          )
                                    )
                                    (cons 410
                                          (if (eq (getvar "CVPORT") 1)
                                            (getvar "CTAB")
                                            "Model"
                                          )
                                    )
                              )
                       )
              )
        )
   (princ "\nIsn't an available object for this function!")
 )
 (setq obj     (ssname js 0)
       dxf_ent (entget obj)
       ename   (vlax-ename->vla-object obj)
       clay    (vla-get-layer ename)
       t_mod   '+
       key     "Yes"
 )
 (if (setq w (cdr (assoc 43 dxf_ent)))
   (progn (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
                space (if (= 1 (getvar "CVPORT"))
                        (vla-get-paperspace acdoc)
                        (vla-get-modelspace acdoc)
                      )
                x     0.0
          )
          ;;RJP check if at least one segment is longer than 10
          (repeat (fix (vlax-curve-getendparam ename))
            (if (> (distance (vlax-curve-getpointatparam ename x)
                             (vlax-curve-getpointatparam ename (setq x (1+ x)))
                   )
                   10.
                )
              (setq flag t)
            )
          )
          (setq pr      -0.5
                t_char  64
                js_text (ssadd)
                x       0.0
          )
          (if (and (eq key "Yes") flag)
            ;;RJP add - If at least one segment is greater than 10 
            (repeat (fix (vlax-curve-getendparam ename))
              (setq pt    (vlax-curve-getpointatparam ename (setq pr (1+ pr)))
                    deriv (vlax-curve-getfirstderiv ename pr)
                    rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                    d     (distance (vlax-curve-getpointatparam ename x)
                                    (vlax-curve-getpointatparam ename (setq x (1+ x)))
                          )
              )
              (if (> d 5)
                ;;RJP add - If segment length > 5 rock and roll (does not calculate length along arc segment) it's pt to pt
                (progn (setq nw_obj
                              (vla-addmtext space
                                            (vlax-3d-point (setq pt (polar pt
                                                                           ((eval t_mod) rtx (* pi 0.5))
                                                                           (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                    )
                                                           )
                                            )
                                            0.0
                                            (strcat "DN"
                                                    "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                    (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                    ">%).ConstantWidth >% * 1000) \\f "%lu2%pr0">%"
                                            )
                              )
                       )
                       (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                         (setq rtx (+ rtx pi))
                       )
                       (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                               (list 'attachmentpoint   'height            'drawingdirection
                                     'insertionpoint    'stylename         'layer
                                     'rotation
                                    )
                               (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                       )
                       (setq out (cons nw_obj out))
                )
              )
            )
            ;;RJP add - Else no segments greater than 10 get midpoint of polyline
            (progn (setq pt    (vlax-curve-getpointatdist
                                 ename
                                 (/ (vlax-curve-getdistatpoint ename (vlax-curve-getendpoint ename)) 2)
                               )
                         deriv (vlax-curve-getfirstderiv ename (vlax-curve-getparamatpoint ename pt))
                         rtx   (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                   )
                   (setq
                     nw_obj (vla-addmtext space
                                          (vlax-3d-point (setq pt (polar pt
                                                                         ((eval t_mod) rtx (* pi 0.5))
                                                                         (+ (getvar "TEXTSIZE") (/ w 2.))
                                                                  )
                                                         )
                                          )
                                          0.0
                                          (strcat "DN"
                                                  "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                                                  (itoa (vla-get-objectid (vlax-ename->vla-object obj)))
                                                  ">%).ConstantWidth >% * 1000) \\f "%lu2%pr0">%"
                                          )
                            )
                   )
                   (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5))))
                     (setq rtx (+ rtx pi))
                   )
                   (mapcar '(lambda (pr val) (vlax-put nw_obj pr val))
                           (list 'attachmentpoint   'height            'drawingdirection
                                 'insertionpoint    'stylename         'layer
                                 'rotation
                                )
                           (list 5 (getvar "TEXTSIZE") 5 pt (getvar "TEXTSTYLE") clay rtx)
                   )
                   (setq out (cons nw_obj out))
            )
          )
          ;;RJP add - pickpoint to flip labels or enter to exit
          (while (setq p (getpoint "\nPick a point to flip labels :"))
            (foreach txt out
              (vla-move txt
                        (vla-get-insertionpoint txt)
                        (vlax-3d-point
                          (polar (setq pt (vlax-get txt 'insertionpoint))
                                 (angle pt (setq pt2 (vlax-curve-getclosestpointto ename pt)))
                                 (* 2. (distance pt pt2))
                          )
                        )
              )
            )
          )
   )
   (princ "\nThis polyline does not have a constant width!")
 )
 (prin1)
)

dani · 发表于 2022-7-6 14:59:21

这是我的名字，丹过去了。

ronjonp · 发表于 2022-7-6 15:10:03

Dani，

一幅画抵得上一千个字。。。我重新发布了代码，试一试。

feargt · 发表于 2022-7-6 15:12:50

非常感谢您在这方面花时间。

不幸的是，这似乎不适用于线段长度不超过10个单位的多段线

它适用于具有多个段的柱脚，其中一些段短于10个单位

ronjonp的版本似乎完全符合我的需要，我只需要在周一的办公室里对它进行更多的测试

feargt · 发表于 2022-7-6 15:21:22

嗨，Ronjonp，

这似乎和我描述的一模一样（希望我最初的描述足够好，这不仅仅是巧合）

我会在周一的工作中测试它，并给出一些反馈。但初步测试似乎非常令人满意！

再次非常感谢您，特别感谢您在代码中提供了描述，这样我就可以看到您做了什么，以及您是如何做到的。

ronjonp · 发表于 2022-7-6 15:26:43

很高兴帮助。。。如果它没有按预期工作，请告诉我。

MarcoW · 发表于 2022-7-6 15:36:46

在我尝试了这个程序（只是出于好奇）之后，我想知道是否可以这样做。

假设我们有一个叫做“19mm管道”的层，所以在该层中绘制的所有线都是19mm管道。现在，我将文字放在“19mm”行旁边，或者使用图形中某处解释的线型。有时我会放置一个引线，其中填充了所需的文本“19mm”。

有没有办法在直接显示直径的那条线上放置（某种）引线？
因为线本身没有直径，我知道。也许因为这是一条线，它在一个特定的层上，所以它可以做到。

只是好奇。。。我可以用它。

[编程交流] 修改Lisp

发表回复

精选推荐