在多段线上创建圆乐筑天下 - Powered by Discuz! Archiver

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

这

(defun c:Test (/ la ss)
;;; Tharwat 20. Nov. 2012 ;;;
(if (and (setq *r* (cond ((getdist (strcat "\n Specify Diameter of Circle "
 (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.“指定圆的直径:"; if I select R then </prevoious>
 nothing happened.
 Can you make: if I select R then, "Specify Radius of Circle : "</previous>
 
3. The (dtext) height of number is set at 0.20 (default). 
 I suggest, the number's height will be the same to diameter of circle so it looks
 proportion.
 
Thanks!
 
Notview

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!

 
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 .

Perhaps try something like this:
 


(defun c:polycir ( / ans cnt inc lst opt sel )
(while
 (progn
 (if (= "Diameter" opt)
 (progn
 (initget "Radius")
 (setq ans (getdist (strcat "\nSpecify Diameter " (if *rad* (strcat " <" (rtos (* 2.0 *rad*)) ">: ") ": "))))
 )
 (progn
 (initget "Diameter")
 (setq ans (getdist (strcat "\nSpecify Radius " (if *rad* (strcat " <" (rtos *rad*) ">: ") ": "))))
 )
 )
 (cond
 ( (null ans)
 (setq ans *rad*)
 nil
 )
 ( (= 'str (type ans))
 (setq opt ans)
 )
 ( (= "Diameter" opt)
 (setqans (/ ans 2.0)
 *rad* ans
 )
 nil
 )
 ( (setq *rad* ans)
 nil
 )
 )
 )
)
(if (and (numberp ans) (setq sel (ssget '((0 . "LWPOLYLINE")))))
 (repeat (setq inc (sslength sel))
 (setq cnt 0
 lst nil
 )
 (foreach grp (entget (ssname sel (setq inc (1- inc))))
 (if (and (= 10 (car grp)) (not (member (cdr grp) lst)))
 (progn
 (entmake (list '(0 . "CIRCLE") grp (cons 40 ans)))
 (entmake
 (list
 '(0 . "TEXT")
 (cons 01 (itoa (setq cnt (1+ cnt))))
 (cons 40 ans)
 (cons 07 (getvar 'textstyle))
 grp
 (cons 11 (cdr grp))
 '(72 . 1)
 '(73 . 2)
 )
 )
 (setq lst (cons (cdr grp) lst))
 )
 )
 )
 )
)
(princ)
)在运行程序之前设置当前层（我认为不需要额外的层提示）。

@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

下面是一个快速修改：

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

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告诉我这是你的圆形抹布
再次非常感谢，我喜欢你的代码，它们真的很有用。

页: [1] 2

乐筑天下's Archiver

在多段线上创建圆