论坛 › A/VLISP › 线条交点画圆

pxr201419 发表于 2019-6-2 11:33:20

线条交点画圆

支持线条：*Line,Arc,Ellipse

pxr201419 发表于 2019-6-12 11:55:46

你上面找的这个功能是：如果多线段或样条曲线自身有交点，在交点处画圆，和我的功能不一样。
这里把我的代码上传，以供测试
(defun c:mjd()
        (setvar "OSMODE" 0)
        (if (= (getstring (strcat "线条是否包含圆，y/n<" "n" ">:")) "y")
                (setq sss (ssget '((0 . "*Line,Arc,circle,Ellipse"))) jdst nil)
                (setq sss (ssget '((0 . "*Line,Arc,Ellipse"))) jdst nil))
        (setq n (sslength sss) i 0 ns 0)
        (if (> n 1)(progn
                (while (< i (- n 1))
                        (setq e1 (ssname sss i) j (1+ i))
                       (while (< j n)
                                (setq e2 (ssname sss j))
                                (if (setq jd (vlax-invoke (vlax-ename->vla-object e1)'IntersectWith (vlax-ename->vla-object e2) 0))
                                        (progn
                                                (setq m (length jd) jj 0)
                                                (while (< jj m)
                                                        (setq jd0 (list (nth jj jd)(nth (+ jj 1) jd)(nth (+ jj 2) jd)))
                                                        (setq jdst (cons jd0 jdst))
                                                        (setq jj (+ jj 3) ns (1+ ns))
                                                )        )        )
                               (setq j (1+ j))                )
                        (setq i (1+ i))                )
                (setq ns (length jdst) i 0)
                (setq dis (getreal "\输入圆的半径:"))
                (while (< i ns)
                        (command "circle" (nth i jdst) dis)
                        (setq i (1+ i))        )
                ))
        (princ)
)
(prompt "\n多条线条交点集，命令：mjd")(princ)

r6831800 发表于 2019-6-3 08:58:30

2018版本好像用不了

yangchao2005090 发表于 2019-6-7 19:12:01

不是源码，一个lisp的网站很早就有这个源码了，

niqiu8 发表于 2019-6-7 19:44:59

VLX文件，浪费我一个B

sicky111 发表于 2019-6-9 00:10:09

再加一个pline

pxr201419 发表于 2019-6-9 08:39:02

不知楼上什么意思，是说不支持pline么？

r6831800 发表于 2019-6-11 16:48:34

yangchao2005090 发表于 2019-6-7 19:12
不是源码，一个lisp的网站很早就有这个源码了，

求源码，可以修改圆大小的，谢谢

r6831800 发表于 2019-6-11 16:56:14

(setq rrno1 5)
;;函数名：zjhy（自交画圆）
;;功能：在多段线是线自相交处画圆圈标注      
;;注：多段线为纯线段，不含弧线
(defun c:zjhy(/ $i $j jiaodian lss nn ns os pt1 pt2 pt3 pt4)
(setq lss (Vertexs (car(entsel))));获取定点表
(setq rrno1 (ureal 0 "" "输入圆圈半径" rrno1))
(setq nn 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)(setvar "CMDECHO" 0)
(setq ns (length lss));返回顶点个数
(setq $i 0);循环初始
(setq $j 2);嵌套循环初始
(repeat (- ns 1);循环从第一点到倒数第二点
    (repeat (if(= $i 0)(1-(- ns $j))(- ns $j));循环到第一点(首点除外)
      (setq pt1(nth $i lss));0
      (setq pt2(nth (1+ $i) lss));1
      (setq pt3(nth $j lss));2
      (setq pt4(nth (if(=(1+ $j)ns)0(1+ $j)) lss));3（超过最后一个点跳到第一点）
      (setq jiaodian(inters pt1 pt2 pt3 pt4));判断线段相交
      (if jiaodian(command "CIRCLE" jiaodian rrno1));画圆
      (if jiaodian(setq nn(1+ nn)));计数
      (setq $j (1+ $j))
    )
    (setq $i (1+ $i))
    (setq $j (+ 2 $i))
)
(setvar "osmode" os)
(princ "\n共找到") (princ nn)(princ "个自相交点。")
(prin1)
)
(prompt
"\n******* zjhy[自交画圆]命令加载完成！*******------tryhi----2015-9-10"
)(prin1)
;;返回多段线顶点表         
(defun Vertexs (s1 / lst);
    (setqlst (entget s1)
      lst (vl-remove-if-not '(lambda (x) (= (car x) 10)) lst)
      lst (mapcar 'cdr lst)
    )
)
;;                  实型数输入格式化                           
(defun ureal (bit kwd msg def / inp)
(if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ") bit (* 2 (fix (/ bit 2))))
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)

网上找了一个但是不能用，，

hbshyjch 发表于 2019-7-6 22:42:43

很好，很需要，谢谢

hbshyjch 发表于 2019-7-6 22:53:04

很好，刚好需要，谢谢{:1_1:}{:1_1:}{:1_1:}

吴外安放 发表于 2020-7-27 08:41:03

谢谢版主分享

庸而学 发表于 2020-11-21 17:33:27

pxr201419 发表于 2019-6-12 11:55
你上面找的这个功能是：如果多线段或样条曲线自身有交点，在交点处画圆，和我的功能不一样。
这里把我的代 ...

大师，请问怎样才自身交点不包含在里面？麻烦了，谢谢

xvjiex 发表于 2021-5-5 00:14:57

感谢楼主分享线条交点画圆！

冷月冰魂 发表于 2024-5-13 07:38:28

请问下加载后，cad 命令行里面 中文字符显示乱码怎么解决？

查看完整版本: 线条交点画圆