坡度箭头

woodman78 · 发表于 2022-7-6 11:50:18

我们过去在VB中有一个例程，用于以%表示直线的斜率。写它的人已经离开了办公室，与lisp相比，我对VB的了解更少。我想知道是否有人可以编写一个lisp来生成箭头广告文本，如所附文件中所示，基于当前的textstyle和dimstyle？

谢谢

lpseifert · 发表于 2022-7-6 11:59:54

哦，试试看。。。我相信如果你陷入困境，这里会有人帮助你。

这可能会帮助你开始

copy


;;;returns slope of line/polyline in profile LPS with help from ronjomp 2008
(defun c:sl ()
 (vl-load-com)
 (setq ent (entsel))
 (if (= (cdr (assoc 0 (entget (car ent)))) "LINE")
   (progn
     (setq lst     (entget (car ent))
       pt1     (cdr (assoc 10 lst))
       pt2     (cdr (assoc 11 lst))
       x1     (car pt1)
       y1     (cadr pt1)
       x2     (car pt2)
       y2     (cadr pt2)
       dy     (- y2 y1)
       dx     (- x2 x1)
       slp     (* 100 (/ dy dx))
       slp2 (/ dx dy)
       txtx (rtos (abs dx) 2 2)
       txty (rtos dy 2 2)
       txts (rtos slp 2 2)
       txts2 (rtos slp2 2 2)
     )                    ;setq
   )                    ;progn
   (progn
     (setq pt    (osnap (cadr ent) "nea")
       ent    (car ent)
     )                    ;setq
     (defun getadjacentplinevertices (ent pt / i p1 p2)
   (if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
     (progn
       (setq i  (fix (vlax-curve-getParamAtPoint
               ent
               (vlax-curve-getClosestPointTo ent pt)
             )
            )
         p1 (vlax-curve-getPointAtParam ent i)
         p2 (vlax-curve-getPointAtParam ent (+ 1 i))
       )
       (setq ls1 (list p1 p2))
     )                ;progn
   )                ;if
     )                    ;defun
     (getadjacentplinevertices ent pt)
     (setq p1x     (car (car ls1))
       p1y     (cadr (car ls1))
       p2x     (car (cadr ls1))
       p2y     (cadr (cadr ls1))
       dx     (- p2x p1x)
       dy     (- p2y p1y)
       slp     (* 100 (/ dy dx))
       slp2 (/ dx dy)
       txtx (rtos (abs dx) 2 2)
       txty (rtos dy 2 2)
       txts (rtos slp 2 2)
       txts2 (rtos slp2 2 2)
     )                    ;setq
   )                    ;progn
 )                    ;if
 (prompt (strcat "\nHorizontal distance = " txtx "'"
                "\nRelief = " txty "'"
                "\nSlope is " txts "%..." txts2 ":1")
)
   
(princ)
)

woodman78 · 发表于 2022-7-6 12:02:17

谢谢，这有什么我需要的基本知识，但可以把它的格式根据我的图片在开始后？？

lpseifert · 发表于 2022-7-6 12:06:57

是的，它可以。。。你有没有试过？

woodman78 · 发表于 2022-7-6 12:16:42

说实话，我不知道从哪里开始。。。。。

woodman78 · 发表于 2022-7-6 12:19:18

有人能帮忙吗？？？

fixo · 发表于 2022-7-6 12:23:15

试试这个
文字高度将与当前标注样式的文字高度相同

[code]；；绘制箭头w/slop（defun c:das（/ang coords dx dy elist en ent ldlist ldpt mpt p1 p2 pline seg num slp sorted txpt tang txth txts unsorted）（while（setq ent（entsel）“\n选择多段线的所需段（或pres Enter to Exit）：”）（if（eq“LWPOLYLINE”（cdr（assoc 0（setq elist（entget（setq en（car ent）kа））））））（progn（setq coords（vl remove if（function not）（mapcar（function（lambda（x）（if（=10（car x））（cdr x））））elist））（setq seg\u num（1+（fix（vlax curve getparamatpoint en（vlax curve getclosestpointto en（cadr ent k）））（setq p2（nth（1-seg\u num）coords）p1（nth seg\u num coords）unsorted（list p2 p1））（setq sorted（vl sort unsorted）（function（lambda（a b）（<（car a）（car b а）а）p1（car排序）p2（cadr排序）mpt（mapcar（函数（λ（a b）（/（+a b）2））（setq dx（-（car p2）（car p1））dy（-（cadr p2）（cadr p1））slp（*100（/dy dx））txts（rtos（abs slp）2））（setq ang（角度p1 p2）txth（getvar“DIMTXT”）；