yp9819 发表于 2020-5-7 08:31:30

多段线两端画圆，修改

多段线两端画圆，为什么画不出，请大师修改。谢谢
(defun c:TT      (/ ss1 slth ename ent point1 point2 n)
(setvar "cmdecho" 0)
(setq      ss1(ssget '((0 . "PLINE")))
      slth (sslength ss1)
)
(setq n 0)
(if (/= ss1 nil)
    (repeat slth
      (setq ename(ssname ss1 n)
            ent         (entget ename)
            point1 (cdr (assoc 10 ent))
            point2 (cdr (assoc 11 ent))
      )
      (command "_donut" 0.0 0.4 point1 point2 "")
      (setq n (+ 1 n))
    )
)
)
(princ "\n 直线两侧绘制实心圆 huyuan")

taoyi0727 发表于 2020-5-7 09:39:11

(defun c:dyxldhy (/ ent lst n radius slth ss1 temp)
(setvar "cmdecho" 0)
(setq
                ss1(ssget '((0 . "LWPOLYLINE")))
                slth (sslength ss1)
)
(setq n 0)
(if (and
                                (/= ss1 nil)
                                (setq radius (getreal "\n请输入半径"))
                        )
    (repeat slth
                        (setq lst nil)
                        (setq ent (entget (ssname ss1 n)))
                        (while (setq temp (car ent))
                                (if (= (car temp) 10)
                                        (setq lst (append lst (list (cdr temp))))
                                )
                                (setq ent (cdr ent))
                        )
                        (command "_CIRCLE" (car lst) radius)
                        (command "_CIRCLE" (last lst) radius)
      (setq n (+ 1 n))
    )
)
)

taoyi0727 发表于 2020-5-7 09:03:09

(defun c:TT (/ ent lst n slth ss1 temp)
(setvar "cmdecho" 0)
(setq
                ss1(ssget '((0 . "LWPOLYLINE")))
                slth (sslength ss1)
)
(setq n 0)
(if (/= ss1 nil)
    (repeat slth
                        (setq lst nil)
                        (setq ent (entget (ssname ss1 n)))
                        (while (setq temp (car ent))
                                (if (= (car temp) 10)
                                        (setq lst (append lst (list (cdr temp))))
                                )
                                (setq ent (cdr ent))
                        )
                        (command "_donut" 0.0 0.4 (car lst) "")
                        (command "_donut" 0.0 0.4 (last lst) "")
      (setq n (+ 1 n))
    )
)

菜卷鱼 发表于 2020-5-7 09:11:49

多段线没有 (assoc 11 ent) ,只有普通直线有， 多段线的点 都是 (cons 10 pt)集合

(setq pts (vl-remove-if-not '(lambda(x) (= 10 (car x))) ent))
(foreach pt pts
(command "_donut" 0.0 0.4 (cdrpt) "")
)

yp9819 发表于 2020-5-7 09:13:33

taoyi0727 发表于 2020-5-7 09:03
(defun c:TT (/ ent lst n slth ss1 temp)
(setvar "cmdecho" 0)
(setq


谢谢老师，能不能修改下，这个程序是画实心圆，半径很小，我想修改为绘制空心圆，半径可以设置输入。

yp9819 发表于 2020-5-7 09:25:11

谢谢老师，老师的程序其他我没有修改，我就只修改了命令名
defun c:dyxldhy (/ ent lst n slth ss1 temp)
可是加载后，提示
命令: dyxldhy
未知命令“DYXLDHY”。按 F1 查看帮助。

yp9819 发表于 2020-5-7 09:47:26

taoyi0727 发表于 2020-5-7 09:39
(defun c:dyxldhy (/ ent lst n radius slth ss1 temp)
(setvar "cmdecho" 0)
(setq


感谢感谢老师，测试成功了！
页: [1]
查看完整版本: 多段线两端画圆，修改