线条交点画圆

pxr201419

支持线条：*Line,Arc,Ellipse

pxr201419

你上面找的这个功能是：如果多线段或样条曲线自身有交点，在交点处画圆，和我的功能不一样。
这里把我的代码上传，以供测试
(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

2018版本好像用不了

yangchao2005090

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

niqiu8

VLX文件，浪费我一个B

sicky111

再加一个pline

pxr201419

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

r6831800

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

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

r6831800

[code="lisp] (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);
    (setq  lst (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

很好，很需要，谢谢

hbshyjch

很好，刚好需要，谢谢

吴外安放

谢谢版主分享

庸而学

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

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

xvjiex

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

冷月冰魂

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