箭头在线乐筑天下 - Powered by Discuz! Archiver

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

箭头在线

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

(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是长度。

(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

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

你差点就成功了。

(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)
)
)

Scrimski 发表于 2022-7-6 14:52:02

这（原始）代码的作者真的很好，至少他对DXF代码非常熟悉。

如果我写了代码，我会使用图案填充而不是可变的PLine宽度。但给出的解决方案要好得多。

来自奥地利的问候-斯克里姆斯基

Commandobill 发表于 2022-7-6 14:55:03

如果我最初编写代码，我会使用leaders。只有我的2美分

Small Fish 发表于 2022-7-6 14:57:06

谢谢Commandobill，太好了。还有一个问题，我明白了

（cons 40 2）或（cons 41 0）

什么样的数字是2。或0。而不是2.0或0.0？

编辑：我刚刚注意到箭头的尖端与直线的终点不在同一点上。因此，它使线路更长。
我会试着去修复它。。。

谢谢小鱼

页: [1] 2

乐筑天下's Archiver

箭头在线