在多段线上创建圆

notview · 发表于 2022-7-6 06:35:56

有人有lisp文件可以在多段线顶点上创建圆吗？
有一个选项询问dia。或要创建的圆半径，并带有一个层。
这确实有助于识别我的测量图的实际拍摄。。

Tharwat · 发表于 2022-7-6 06:40:23

试试这个。。。


(defun c:Test (/ ss di la)
 ;;; Tharwat 14. Nov. 2012   ;;;
 (if (and (setq ss (ssget '((0 . "*POLYLINE"))))
          (setq di (getdist "\n Specify Circle Radius :"))
          (not (eq (setq la (getstring t "\n Enter Layer name :")) ""))
          (tblsearch "LAYER" la)
     )
   ((lambda (x / e)
      (while (setq e (ssname ss (setq x (1+ x))))
        (foreach dxf (entget e)
          (if (eq (car dxf) 10)
            (entmakex (list '(0 . "CIRCLE") dxf (cons 40 di) (cons 8 la)))
          ) ) )
    )
     -1
   )
   (princ)
 )
 (princ)
)

notview · 发表于 2022-7-6 06:45:00

非常好的节目！！

如果可能的话，你能做到：
指定半径圆：“到”
“指定圆的直径[半径]：

然后在距离圆心的圆旁边写下（dtext）数字
圆半径的1.5x。这个数和顶点数是一样的。

大Thnax！！

Notview公司

Tharwat · 发表于 2022-7-6 06:50:18

这

copy


(defun c:Test (/ la ss)
;;; Tharwat 20. Nov. 2012   ;;;
 (if (and (setq *r* (cond ((getdist (strcat "\n Specify Diameter of Circle [Radius]"
                                            (if *r*
                                              (strcat "< " (rtos *r* 2 2) " > :")
                                              " :"
                                            )
                                    )
                           )
                          )
                          (t *r*)
                    )
          )
          (not (eq (setq la (getstring t "\n Enter Layer name :")) ""))
          (if (not (tblsearch "LAYER" la))
            (progn (princ "\n Layer Name is not found !!") nil)
            t
          )
          (setq ss (ssget '((0 . "*POLYLINE"))))
     )
   ((lambda (x / e i)
      (while (setq e (ssname ss (setq x (1+ x))))
        (setq i 0)
        (foreach dxf (entget e)
          (if (eq (car dxf) 10)
            (progn (entmakex (list '(0 . "CIRCLE") dxf (cons 40 *r*) (cons 8 la)))
                   (entmakex (list '(0 . "TEXT")
                                   (cons 1 (itoa (setq i (1+ i))))
                                   '(40 . 0.2)
                                   (cons 10 (trans (list (+ (cadr dxf) (* *r* 1.1)) (caddr dxf) 0.) 1 0))
                                   (cons 8 la)
                             )
                   )
            ) ) )  ) ) -1
   )
   (princ)
 )
 (princ)
)

notview · 发表于 2022-7-6 06:54:00

运行后我注意到：

1.“指定圆的直径[半径]：”；结果是之后的圆半径
它被画出来了。

2.“指定圆的直径[Radius]

copy

:  "  ; if I select R then </prevoious></p>
<p>       nothing happened.</p>
<p>      Can you make: if I select R then, "Specify Radius of Circle [code]: "</previous></p>
<p> </p>
<p>  3. The (dtext) height of number is set at 0.20 (default). </p>
<p>      I suggest, the number's height will be the same to diameter of circle so it looks</p>
<p>      proportion.</p>
<p> </p>
<p>Thanks!</p>
<p> </p>
<p>Notview</p>
                        
                 <p>Tharwat, I follow your code and test it in a polyline having four vertex but what I've notice is the last number also occupies the number 1 vertex.. is it possible to do the numbering just up to 4 and not 5? in 4 vertex polyline? thanks!</p>
                        
                 <p> </p>
<p>If you have used the command rectang to draw a square polyline , the code should work as expected , but if you use the command polyline to draw a square polyline just draw the four point and use the option close to close the square without picking the the start point once again to close the polyline .</p>
                        
                 <p>Perhaps try something like this:</p>
<p> </p>
<p></p>
[code]
([color=BLUE]defun[/color] c:polycir ( [color=BLUE]/[/color] ans cnt inc lst opt sel )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"Diameter"[/color] opt)
               ([color=BLUE]progn[/color]
                   ([color=BLUE]initget[/color] [color=MAROON]"Radius"[/color])
                   ([color=BLUE]setq[/color] ans ([color=BLUE]getdist[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSpecify Diameter [Radius]"[/color] ([color=BLUE]if[/color] *rad* ([color=BLUE]strcat[/color] [color=MAROON]" <"[/color] ([color=BLUE]rtos[/color] ([color=BLUE]*[/color] 2.0 *rad*)) [color=MAROON]">: "[/color]) [color=MAROON]": "[/color]))))
               )
               ([color=BLUE]progn[/color]
                   ([color=BLUE]initget[/color] [color=MAROON]"Diameter"[/color])
                   ([color=BLUE]setq[/color] ans ([color=BLUE]getdist[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSpecify Radius [Diameter]"[/color] ([color=BLUE]if[/color] *rad* ([color=BLUE]strcat[/color] [color=MAROON]" <"[/color] ([color=BLUE]rtos[/color] *rad*) [color=MAROON]">: "[/color]) [color=MAROON]": "[/color]))))
               )
           )
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]null[/color] ans)
                   ([color=BLUE]setq[/color] ans *rad*)
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]=[/color] 'str ([color=BLUE]type[/color] ans))
                   ([color=BLUE]setq[/color] opt ans)
               )
               (   ([color=BLUE]=[/color] [color=MAROON]"Diameter"[/color] opt)
                   ([color=BLUE]setq[/color]  ans ([color=BLUE]/[/color] ans 2.0)
                         *rad* ans
                   )
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]setq[/color] *rad* ans)
                   [color=BLUE]nil[/color]
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]numberp[/color] ans) ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color])))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
           ([color=BLUE]setq[/color] cnt 0
                 lst [color=BLUE]nil[/color]
           )
           ([color=BLUE]foreach[/color] grp ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc))))
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] grp)) ([color=BLUE]not[/color] ([color=BLUE]member[/color] ([color=BLUE]cdr[/color] grp) lst)))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"CIRCLE"[/color]) grp ([color=BLUE]cons[/color] 40 ans)))
                       ([color=BLUE]entmake[/color]
                           ([color=BLUE]list[/color]
                              '(0 . [color=MAROON]"TEXT"[/color])
                               ([color=BLUE]cons[/color] 01 ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] cnt ([color=BLUE]1+[/color] cnt))))
                               ([color=BLUE]cons[/color] 40 ans)
                               ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                               grp
                               ([color=BLUE]cons[/color] 11 ([color=BLUE]cdr[/color] grp))
                              '(72 . 1)
                              '(73 . 2)
                           )
                       )
                       ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] grp) lst))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

在运行程序之前设置当前层（我认为不需要额外的层提示）。

@Tharwat：注意，您的代码允许选择2D（粗）或3D多段线，但只能处理LWD多段线。

Ahmeds · 发表于 2022-7-6 06:55:28

你说得对，李，

我最近注意到，dxf 10无法像LWpolyline那样收集3Dpoly的坐标点。

Tharwat · 发表于 2022-7-6 06:59:03

再次感谢李，请再帮我一个忙。。
1）你能在里面再加一行，问哪个是想要的角#1（我会选哪个）
2）转角编号应偏离我所需距离的转角。

还要感谢塔瓦，谢谢。。。干杯：拇指支撑：

Lee Mac · 发表于 2022-7-6 07:05:36

下面是一个快速修改：

copy


([color=BLUE]defun[/color] c:polycir ( [color=BLUE]/[/color] ans cnt ent lst opt vtx )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color]
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] [color=MAROON]"Diameter"[/color] opt)
               ([color=BLUE]progn[/color]
                   ([color=BLUE]initget[/color] [color=MAROON]"Radius"[/color])
                   ([color=BLUE]setq[/color] ans ([color=BLUE]getdist[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSpecify Diameter [Radius]"[/color] ([color=BLUE]if[/color] *rad* ([color=BLUE]strcat[/color] [color=MAROON]" <"[/color] ([color=BLUE]rtos[/color] ([color=BLUE]*[/color] 2.0 *rad*)) [color=MAROON]">: "[/color]) [color=MAROON]": "[/color]))))
               )
               ([color=BLUE]progn[/color]
                   ([color=BLUE]initget[/color] [color=MAROON]"Diameter"[/color])
                   ([color=BLUE]setq[/color] ans ([color=BLUE]getdist[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSpecify Radius [Diameter]"[/color] ([color=BLUE]if[/color] *rad* ([color=BLUE]strcat[/color] [color=MAROON]" <"[/color] ([color=BLUE]rtos[/color] *rad*) [color=MAROON]">: "[/color]) [color=MAROON]": "[/color]))))
               )
           )
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]null[/color] ans)
                   ([color=BLUE]setq[/color] ans *rad*)
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]=[/color] 'str ([color=BLUE]type[/color] ans))
                   ([color=BLUE]setq[/color] opt ans)
               )
               (   ([color=BLUE]=[/color] [color=MAROON]"Diameter"[/color] opt)
                   ([color=BLUE]setq[/color] ans ([color=BLUE]/[/color] ans 2.0) *rad* ans)
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]setq[/color] *rad* ans)
                   [color=BLUE]nil[/color]
               )
           )
       )
   )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]numberp[/color] ans)
           ([color=BLUE]setq[/color] ent ([color=BLUE]ssget[/color] [color=MAROON]"_+.:E:S"[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]))))
           ([color=BLUE]setq[/color] vtx ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify First Vertex: "[/color]))
       )
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] ent 0)
                 vtx ([color=BLUE]fix[/color] ([color=BLUE]vlax-curve-getparamatpoint[/color] ent ([color=BLUE]vlax-curve-getclosestpointto[/color] ent ([color=BLUE]trans[/color] vtx 1 0))))
                 cnt 0
           )
           ([color=BLUE]foreach[/color] grp ([color=BLUE]reverse[/color] ([color=BLUE]entget[/color] ent))
               ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] grp)) ([color=BLUE]not[/color] ([color=BLUE]member[/color] ([color=BLUE]cdr[/color] grp) lst)))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] grp) lst))
               )
           )
           ([color=BLUE]repeat[/color] vtx ([color=BLUE]setq[/color] lst ([color=BLUE]append[/color] ([color=BLUE]cdr[/color] lst) ([color=BLUE]list[/color] ([color=BLUE]car[/color] lst)))))
           ([color=BLUE]foreach[/color] pnt lst
               ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"CIRCLE"[/color]) ([color=BLUE]cons[/color] 10 pnt) ([color=BLUE]cons[/color] 40 ans)))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"TEXT"[/color])
                       ([color=BLUE]cons[/color] 01 ([color=BLUE]itoa[/color] ([color=BLUE]setq[/color] cnt ([color=BLUE]1+[/color] cnt))))
                       ([color=BLUE]cons[/color] 40 ans)
                       ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                       ([color=BLUE]cons[/color] 10 pnt)
                       ([color=BLUE]cons[/color] 11 pnt)
                      '(72 . 1)
                      '(73 . 2)
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=blue]vl-load-com[/color]) ([color=BLUE]princ[/color])

Tharwat · 发表于 2022-7-6 07:08:58

谢谢李，你看到这个帖子了吗？
http://www.cadtutor.net/forum/showthread.php?76878-Like-a-text-mask-can-LISP-it-the-same-in-circle-if-yes-how
你能给我一些提示或代码吗？

Ahmeds · 发表于 2022-7-6 07:10:30

其实我已经找到了，但还没有试过。。nod684告诉我这是你的圆形抹布
再次非常感谢，我喜欢你的代码，它们真的很有用。

[编程交流] 在多段线上创建圆

发表回复

精选推荐