箭头在线

Small Fish · 发表于 2022-7-6 14:23:59

我发现这段代码是由未知作者编写的。我想把它编辑成这样
箭头的大小不同。我想我必须编辑这行：
（λ（g）（vl位置（汽车g）'（-1 0 5 100 10 11 210）））
但我无法理解这些数字的含义。
我还想在同一行上添加另一个箭头
所以有两个箭头。有人知道这段代码是怎么工作的吗？
谢谢

copy

(defun c:pidarrow (/ Ent EntName Point Points)
 (and
   (setq Ent (entsel "\nSelect Line near Arrow End: "))
   (setq Point      (cadr Ent)
     EntName (car Ent)
     Ent      (entget EntName)
   )
   (= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
        (distance Point (cadr Points))
     )
   (setq Points (reverse Points))
     )
     (entmakex
   (append
     (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
     (vl-remove-if
       (function
         (lambda (g) (vl-position (car g) '(-1 0 5 100 10 11 210)))
       )
       Ent
     )
     (list (cons 100 "AcDbPolyline") (cons 90 3) (cons 70 0))
     (mapcar (function (lambda (p) (cons 10 p))) Points)
     (list    (cons 40 4.)
       (cons 41 0.)
       (cons 10 (polar (cadr Points) (apply 'angle Points) 8.0))
     )
   )
     )
   )
   (entdel EntName)
 )
)

Commandobill · 发表于 2022-7-6 14:28:25

我修改了代码（尽管我不同意它的工作原理），这样就可以在行的两侧都有一个箭头。我还注释了箭头的长度和宽度的更改位置。8.0是长度。

copy

(defun c:pidarrow (/ Ent EntName Point Points)
 (and
   (setq Ent (entsel "\nSelect Line near Arrow End: "))
   (setq Point      (cadr Ent)
     EntName (car Ent)
     Ent      (entget EntName)
   )
   (= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
        (distance Point (cadr Points))
     )
   (setq Points (reverse Points))
     )
     (entmakex
   (append
     (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
     (vl-remove-if
       (function
         (lambda (g) (vl-position (car g) '(-1 0 5 100 10 11 210)))
       )
       Ent
     )
     (list (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0))
                
     (if (or (= (setq op (strcase (getstring "\nDo you want an arrow on both sides? (Yes or No): "))) "Y")
         (= op "YES"))
   (progn
         (list   (cons 10 (polar (car Points) (apply 'angle Points) -8.0));length of arrow
         (cons 40 0.)
         (cons 41 2.)))); width of arrow
     (mapcar (function (lambda (p) (cons 10 p))) Points)
     (list    (cons 40 2.); width of arrow
          (cons 41 0.)
          (cons 10 (polar (cadr Points) (apply 'angle Points) 8.0)));length of arrow
     )))
   (entdel EntName)
   (princ)
 )
)

Small Fish · 发表于 2022-7-6 14:33:09

谢谢比尔。这并不是我真正想要的，尽管它也很有用。谢谢你教我如何调整箭头大小。我要做的是选择在一端指向同一方向的双箭头。下面是我试图调整的代码，以便它可以做到这一点，不幸的是，我的第二个箭头是线的长度！问题的一部分是我也不理解原始代码的一半。

copy

 (defun c:pidarrow1 (/ Ent EntName Point Points FirstPt)
 (and
   (setq Ent     (entsel "\nSelect Line near Arrow End: ");list of entity properties
         Point   (cadr   Ent)
         EntName (car    Ent);entity name
         Ent     (entget EntName)
   )
(= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
        (distance Point (cadr Points))
     )
   (setq Points (reverse Points))
     )
    (setq FirstPt  (car(reverse Points)))
  (setq SecondPt (polar (cadr Points)(apply 'angle Points)-2.5))
      
     (entmakex
   (append
     (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
     (vl-remove-if
       (function
         (lambda (g) (vl-position (car g) '(-1 0 5 100 10 11 210)))
       )
       Ent
     )
     (list (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0))
                
     (if (or (= (setq op (strcase (getstring "\nDo you want a double arrow head? (Yes or No): "))) "Y")
         (= op "YES"))
   (progn
            (list   (cons 10 (polar FirstPt (apply 'angle Points) 2.5));length of arrow  
                 (cons 40 0.)
                 (cons 41 0.83333)))); width of arrow
         (mapcar (function (lambda (p) (cons 10 p))) Points)
     (list    (cons 40 0.83333); width of arrow
          (cons 41 0.)
          (cons 10 (polar (cadr Points) (apply 'angle Points) 2.5)));length of arrow
     ))
     )
   (entdel EntName)
   (princ)
 )
)

David Bethel · 发表于 2022-7-6 14:37:10

如果你想要一条两端都有箭头的简单引线，我会用这样的方法：
大卫

Commandobill · 发表于 2022-7-6 14:38:32

你能举一个双箭头应该是什么样子的例子吗？

Small Fish · 发表于 2022-7-6 14:45:18

它应该看起来像这样。。。。。。
我的最后一条代码信息就在那里了——第二个箭头延伸到了整行。

Commandobill · 发表于 2022-7-6 14:47:18

你差点就成功了。

copy

(defun c:pidarrow (/ Ent EntName Point )
 (and
   (setq Ent (entsel "\nSelect Line near Arrow End: "))
   (setq Point      (cadr Ent)
     EntName (car Ent)
     Ent      (entget EntName)
     )
   (= (cdr (assoc 0 Ent)) "LINE")
   (progn
     (setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent))))
     (if (< (distance Point (car Points))
        (distance Point (cadr Points))
        )
   (setq Points (reverse Points))
   )
     (entmakex
   (append
     (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity"))
     (list (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 0))
     
     
     
     (mapcar (function (lambda (p) (cons 10 p))) Points)
     (list    (cons 40 2.); width of arrow
          (cons 41 0.)
          (cons 10 (setq npoint (polar (cadr Points) (apply 'angle Points) 8.0))));length of arrow
     (if (or (= (setq op (strcase (getstring "\nDo you want a double arrow head? (Yes or No): "))) "Y")
         (= op "YES"))
       (list  (cons 40 2.); width of arrow
          (cons 41 0.)
          (cons 10 (polar npoint (apply 'angle Points) 8.0)))
       
       ))))
     (entdel EntName)
     (princ)
     )
   )