增量属性

Tharwat · 发表于 2022-7-5 18:36:06

不用担心，我今天在办公室写了一个关于这个问题的例行程序，所以明天我会发布代码，因为现在我在家。

Tharwat · 发表于 2022-7-5 18:39:40

试试这个。。。


(defun c:Test (/ *error* IsAttributed Spread_The_Block s d l blk at)
 (vl-load-com)
 ;; Tharwat 15. 01. 2013 ;
 (defun *error* (x)
   (if at
     (setvar 'attdia at)
   )
   (princ "\n*Cancel*")
 )
 (or Doc (setq Doc (vla-get-ActiveDocument (vlax-get-acad-object))))
 (defun IsAttributed (Doc name / yes)
   (vlax-for o (vla-item (vla-get-blocks Doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq yes t)
     )
   )
   yes
 )
 (defun Spread_The_Block (s l d rm blk / sg i mrk)
   (if rm
     (setq sg  rm
           i   (* d (fix (/ l d)))
           mrk '-
     )
     (setq sg  d
           i   d
           mrk '+
     )
   )
   (repeat (fix (/ l d))
     (vl-cmdf "_.-insert"
              blk
              "_non"
              (vlax-curve-getpointatdist s sg)
              "1."
              "1.0"
              "0."
              (strcat "DC-" (rtos i 2 0))
     )
     (setq sg (+ sg d)
           i  (apply mrk (list i d))
     )
   )
 )
 (setq blk "DC")  ;; Specify Attibuted block name here with one attributes 
 (if (and (if (not (tblsearch "BLOCK" blk))
            (progn (princ "\n Block name is not found in Drawing !!") nil)
            t
          )
          (if (not (IsAttributed Doc blk))
            (progn (princ "\n Block name is not Attributed Block !!") nil)
            t
          )
          (setq d (getreal "\n Increment Distance:"))
          (setq s (car (entsel "\n Select Polyline:")))
     )
   (progn (setq at (getvar 'attdia))
          (setvar 'attdia 0)
          (setq l (vlax-curve-getdistatparam s (vlax-curve-getendparam s)))
          (if (> (car (vlax-curve-getstartpoint s)) (car (vlax-curve-getendpoint s)))
            (Spread_The_Block s l d (rem l d) blk)
            (Spread_The_Block s l d nil blk)
          )
          (setvar 'attdia at)
   )
 )
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)

gS7 · 发表于 2022-7-5 18:41:42

Tharwat我印象深刻谢谢

Tharwat · 发表于 2022-7-5 18:45:46

我很高兴你喜欢它。

rayboy · 发表于 2022-7-5 18:46:34

塔尔瓦特，

我刚刚发现了沿多段线放置属性块的lisp例程。它非常好，几乎完全符合我的要求，我有一个问题要问你。

是否很难使块插入，使其垂直于多段线（甚至围绕曲线），而不是当前的垂直？

我正在努力学习lisp，如果你能给我指出正确的方向，我愿意试一试！

当做
约翰

Tharwat · 发表于 2022-7-5 18:49:33

欢迎来到Cadboot rayboy。

你能举一个例子来说明你对这个项目的期望目标吗，不管这个项目在这个线程中是什么？

如果可以，请上载样例图形。

Tharwat · 发表于 2022-7-5 18:53:18

或者这里是如何玩角度的方法。

注意：不要忘记在程序中本地化变量“p”。

copy


(vl-cmdf "_.-insert"
              blk
              "_non"
              (setq p (vlax-curve-getpointatdist s sg))
              "1."
              "1.0"
              (/ (* (angle '(0. 0. 0.)
                           (vlax-curve-getfirstderiv
                             s
                             (vlax-curve-getparamatpoint s p)
                           )
                    )
                    180.0
                 )
                 pi
              )
              (strcat "DC-" (rtos i 2 0))
     )

rayboy · 发表于 2022-7-5 18:57:29

谢谢塔瓦，很高兴来到这里。

我附上了一个简单的图纸显示了一个例子。

最上面的示例是lisp生成的内容。下面的例子是我想要的。

块应垂直于多段线（如齿轮上的齿）。

如果它可以在起点（0.0）插入一个块，并将其编号为0.0、0.5、1.0、1.5等，那也很好。
kp测试。图纸

Tharwat · 发表于 2022-7-5 18:59:35

这并不完美，但效果很好，现在您可以选择更多的对象，而不仅仅是多段线。

试试看。

copy


(defun c:Test (/ *error* do isattributed spread_the_block s d l blk vals
              p
             )
 ;; Tharwat 26. 08. 2015 ;
 (defun *error* (x)
   (if vals
     (mapcar 'setvar '(attdia dimzin) vals)
   )
 )
 (defun isattributed (doc name / yes)
   (vlax-for o (vla-item (vla-get-blocks doc) name)
     (if (eq "AcDbAttributeDefinition" (vla-get-objectname o))
       (setq yes t)
     )
   )
   yes
 )
 (defun spread_the_block (s l d blk / sg i mrk)
   (setq sg  d
         i   d
         mrk '+
   )
   (vl-cmdf "_.-insert"
            blk
            "_non"
            (setq p (vlax-curve-getstartpoint s))
            "1."
            "1.0"
            (/ (* (angle '(0. 0. 0.)
                         (vlax-curve-getfirstderiv
                           s
                           (vlax-curve-getparamatpoint s p)
                         )
                  )
                  180.0
               )
               pi
            )
            (strcat "DC-" "0.0")
   )
   (repeat (fix (/ l d))
     (vl-cmdf "_.-insert"
              blk
              "_non"
              (setq p (vlax-curve-getpointatdist s sg))
              "1."
              "1.0"
              (/ (* (angle '(0. 0. 0.)
                           (vlax-curve-getfirstderiv
                             s
                             (vlax-curve-getparamatpoint s p)
                           )
                    )
                    180.0
                 )
                 pi
              )
              (strcat "DC-" (rtos i 2 1))
     )
     (setq i  (apply mrk (list i d))
           sg (+ sg d)
     )
   )
 )
 (setq blk      "kptag1"
       do       (vla-get-activedocument (vlax-get-acad-object))
       *incval* (if *incval*
                  *incval*
                  0.5
                )
 )
 ;; Specify Attibuted block name here with one attributes 
 (if
   (and
     (if (not (tblsearch "BLOCK" blk))
       (progn (princ "\nBlock name is not found in Drawing !!")
              nil
       )
       t
     )
     (if (not (isattributed do blk))
       (progn (princ "\nBlock name is not Attributed Block !!")
              nil
       )
       t
     )
     (progn (initget 6)
            (setq
              *incval* (cond ((getdist (strcat "\n Increment Distance <"
                                               (rtos *incval* 2 2)
                                               "> :"
                                       )
                              )
                             )
                             (t *incval*)
                       )
            )
     )
     (setq s (car (entsel "\nPick on [Polyline,Line,Arc,Spline]:")))
     (wcmatch (cdr (assoc 0 (entget s)))
              "LWPOLYLINE,LINE,ARC,SPLINE"
     )
   )
    (progn (setq vlas (mapcar 'getvar '(attdia cmdecho dimzin)))
           (mapcar 'setvar '(attdia cmdecho dimzin) '(0 0 0))
           (setq l (vlax-curve-getdistatparam s (vlax-curve-getendparam s)))
           (vla-startundomark do)
           (spread_the_block s l *incval* blk)
           (vla-endundomark do)
    )
 )
 (*error* nil)
 (princ "\nWritten by Tharwat Al Shoufi")
 (princ)
)(vl-load-com)

rayboy · 发表于 2022-7-5 19:02:39

谢谢Tharwat，这已经很接近了。

我无法让文本从0开始（从0.5开始），然后它不显示整数的小数位（它显示1而不是1.0）。我已经调整了RTOS值，但它没有显示1.0格式。

[编程交流] 增量属性

发表回复

精选推荐