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

Lee Mac 发表于 2022-7-6 15:01:14

这仍然是一个真实的数字，但懒惰不把零

Small Fish 发表于 2022-7-6 15:05:32

我试图调整代码，但我发现当添加箭头时，线条会移动-不知道为什么？此外，我还没有想出如何使第二个箭头的位置正确-它放在第一个箭头之上，而不是后面。

(defun c:pidarrow (/ ent    entname    point
         npoint    points    pt1
         pt2    anglepts arrowstart1
         arrowstart2arrowstart3 arrowstart4
         pointssecond)
(and
(setq Ent (entsel "\nSelect Line near Arrow End: "))
(setq Point (cadr Ent)
EntName (car Ent)
Ent (entget EntName)
);setq
(= (cdr (assoc 0 Ent)) "LINE")
(progn
(setq Points (list (cdr (assoc 10 Ent)) (cdr (assoc 11 Ent)));10=start pt of line, 11=end pt of line
Pt1 (cdr (assoc 10 Ent))
Pt2 (cdr (assoc 11 Ent))
AnglePts (angle Pt1 Pt2)
ArrowStart1 (polarPt1 (+ AnglePtspi ) -2.5)
ArrowStart2 (polarPt2 (- AnglePtspi ) 2.5)
Points (listArrowStart1 ArrowStart2)

ArrowStart3 (polarArrowStart1 (+ AnglePtspi ) -2.5)
ArrowStart4(polarArrowStart2 (- AnglePtspi ) 2.5)
PointsSecond (list ArrowStart3 ArrowStart4))

(if (< (distance Point (car Points))
   (distance Point (cadr Points))
)
(setq Points (reverse Points))
);if
(entmakex
(append
(list (cons 0 "LWPOLYLINE")
   (cons 100 "AcDbEntity")
);list
(list (cons 100 "AcDbPolyline")
   (cons 90 4);number of vertices?
   (cons 70 0)
);list

(mapcar (function (lambda (p)
   (cons 10 p))) Points)

(list (cons 40 0.833333); width of arrow
   (cons 41 0.0)
   (cons 10 (setq npoint (polar (cadr Points) (apply 'angle Points) 2.5)));length of arrow
);list
(if (or (= (setq op (strcase (getstring "\nDo you want a double arrow head? (Yes or No): "))) "Y")
   (= op "YES"))
(list (cons 40 0.833333); width of arrow
   (cons 41 0.0)
   (cons 10 (polar npoint (apply 'angle Points) 2.5)))
);if
);append
);entmakex
);progn
(entdel EntName)
(princ)
);and
)
;defun

Commandobill 发表于 2022-7-6 15:09:18

我马上看一下你的代码，但现在是这样
(defun c:pidarrow (/ Ent EntName Point pang npoint p1 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"))
(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"))
   (list (cons 10 (setq p1 (car points)))
      (cons 10 (setq npoint (polarp1 (setq pang (apply 'angle Points)) (- (distance p1 (cadr points)) 16.0)))))
   (list (cons 10 (setq p1 (car points)))
      (cons 10 (setq npoint (polarp1 (setq pang (apply 'angle Points)) (- (distance p1 (cadr points)) 8.0))))))

(list (cons 40 2.0); width of arrow
   (cons 41 0.0)
   (cons 10 (setq npoint (polar npoint pang 8.0))));length of arrow
(if (or (= op "Y")
      (= op "YES"))
   (list (cons 40 2.0); width of arrow
      (cons 41 0.0)
      (cons 10 (polar npoint pang 8.0)))
   ))))
(entdel EntName)
(princ)
)
)

Small Fish 发表于 2022-7-6 15:12:44

嘿，谢谢你，Commandobill，太棒了。我的尝试不是正确的方法。我从这段代码中学到了一些东西。
干杯小鱼

Small Fish 发表于 2022-7-6 15:15:25

我现在已经改进了代码，因此它还将接受2条垂直多段线，并对非直线或2条垂直多段线的实体进行错误补漏白。
我只是想和任何想用它的人分享。。。。。。

7

Lee Mac 发表于 2022-7-6 15:17:02

这段代码可以变得更加简洁

试试这个：

（defunc:pidarrow（vl load com（progn（if（“\n选择线条或2个垂直线：“。[颜色=红色]（cond（（eq“LINE”（cdadr（setq红色]（setqent（car（（（cdr（assoc10elstelst）。)nil（（eq“LWPOLYLINE”（（（entgetent （如果（（ptlst（mapcarcdr（[红色]（x）[颜色=红色](10（carx]2（princ“\n**多段线有两个以上的顶点**”（（princ“**选择的对象无效**”princ（setqptlst（vl sortptlst（（（[color=BLUE

Small Fish 发表于 2022-7-6 15:22:12

李-麦克感谢你上的压实课。我明白了，你用的是没有零的实数，即2。或0还是剪贴画上的？
小鱼

Lee Mac 发表于 2022-7-6 15:26:18

随便我喜欢什么真的

请注意我构建对象选择的方式。我倾向于避免过多地使用（exit）函数。

此外，我使用了getkword（和COND）来选择箭头，这比getstring可靠得多。

页: 1 [2]

乐筑天下's Archiver