更改多边形的长度

alanjt · 发表于 2022-7-6 12:43:33

事实上，这一次会让生活更轻松。

(defun c:Test (/ #Ent #Obj #Length #LType #Value)
 (vl-load-com)
 (while (setq #Ent (entsel "\nSelect *line: "))
   (and (vl-position (cdr (assoc 0 (entget (car #Ent)))) '("LWPOLYLINE" "LINE"))
        (setq #Obj    (vlax-ename->vla-object (car #Ent))
              #Length (vla-get-length #Obj)
              #LType  (strcase (vla-get-linetype #Obj))
        ) ;_ setq
        (cond
          ;; hidden2
          ((eq #LType "HIDDEN2") (setq #Value (* 0.5 #Length)))
          ;; phantom2
          ((eq #LType "PHANTOM2") (setq #Value (+ 3 #Length)))
          ;; no match
          (T (alert "No matching Linetypes!"))
        ) ;_ cond
        (vl-cmdf "_.lengthen" "_total" #Value #Ent "")
        (princ (strcat "\nNew Length: " (vl-princ-to-string #Value)))
   ) ;_ and
 ) ;_ while
 (princ)
) ;_ defun

LtRimmer · 发表于 2022-7-6 12:45:07

再次非常感谢，这正是我想要的！

我打算自己做一些工作（老实说）。；-）

alanjt · 发表于 2022-7-6 12:49:08

不客气。

没什么大不了的，这是一个简单的程序，我基本上要写解释。你仍然需要填写所有的条件，所以你也有工作要做眨眼：

LtRimmer · 发表于 2022-7-6 12:51:16

Alanjt，

我在得到一点帮助后，我正在尝试让一个变体工作，你上面提出的。（顺便说一句，效果很好）

我试图得到它，这样我就可以画一条多边形线，然后在命令结束时自动调整大小。我添加了pline来画线，然后ssget来选择添加到数据库中的最后一项，但我无法让它做很多事情。我添加了以下代码：

帮助

copy

(defun c:test ()
 (vl-load-com)
 
 (vl-cmdf "_.pline")
 (setq #Ent (ssget "_l"))
 
 (vl-position (cdr (assoc 0 (entget (car #Ent)))) '("LWPOLYLINE" "LINE"))
 (setq #Obj    (vlax-ename->vla-object (car #Ent))
       #Length (vla-get-length #Obj)
       #LType  (strcase (vla-get-linetype #Obj))
 ) ;_ setq
 (cond
 ;; 4-2
   ((eq #LType "4-2") (setq #Value (+ (* (fix (/ (- #Length 4) 6)) 6) 4)))
 ;; 1-5
   ((eq #LType "1-5") (setq #Value (+ (* (fix (/ (- #Length 1) 6)) 6) 1)))
 ;; no match
   (T (alert "No matching Linetypes!"))
 ) ;_ cond
 (vl-cmdf "_.lengthen" "_total" #Value #Ent "")
 (princ (strcat "\nNew Length: " (vl-princ-to-string #Value)))
)

alanjt · 发表于 2022-7-6 12:56:27

又快又脏，但试试这个：

copy

(defun c:test (/ #Entlast #Ent #Obj #Length #LType #Value)
 (vl-load-com)
 (or (setq #Entlast (entlast)) (setq #Entlast T))
 (vl-cmdf "_.pline")
 (while (not (zerop (getvar 'cmdactive)))
   (princ "\nSpecify next point: ")
   (vl-cmdf PAUSE)
 ) ;_ while
 (cond
   ((not (eq #Entlast (setq #Ent (entlast))))
    (setq #Obj    (vlax-ename->vla-object #Ent)
          #Length (vla-get-length #Obj)
          #LType  (strcase (vla-get-linetype #Obj))
    ) ;_ setq
    (cond
      ;; 4-2
      ((eq #LType "4-2") (setq #Value (+ (* (fix (/ (- #Length 4) 6)) 6) 4)))
      ;; 1-5
      ((eq #LType "1-5") (setq #Value (+ (* (fix (/ (- #Length 1) 6)) 6) 1)))
      ;; no match
      (T (alert "No matching Linetypes!"))
    ) ;_ cond
    (and #Value
         (vl-cmdf "_.lengthen" "_total" #Value (list #Ent (getvar 'lastpoint)) "")
         (princ (strcat "\nNew Length: " (vl-princ-to-string #Value)))
    ) ;_ and
   )
 ) ;_ cond
 (princ)
) ;_ defun