在多段线内插入圆
大家好，我找到并修改了一个适合我需要的旧代码。====================================================================================================
编辑：GP_最初编写了起始代码。谢谢你告诉我，我真的不知道。
您可以在此处找到原始代码：
http://www.cad3d.it/forum1/showthread.php?38359-Disignare cerchi all interno di un Polilina/page2&p=319854#post319854
====================================================================================================
不幸的是，有时速度很慢。。
我想问的是，是否有更好的方法来实现这一结果
(defun dcer ( / *error* passo Dcon Dcon* dmax p_or d2 p L1 L2 Lc cont tot e1 ret EL EL* LIN n Lc del)
; richiesta distanza dal contorno
;*************************************
(setq Rd 2)
;*************************************
(setq olderr *error* *error* myerror_**)
(m_v (list "cmdecho" "hporigin" "hpbound" )) ;estrare le variabili e ne fa una lista (("cmdecho".0) ("hporigin" . ...) ..)
;hporigin Imposta il punto di origine del tratteggio per i nuovi modelli di tratteggio rispetto all'UCS corrente.
;Controlla il tipo di oggetto creato dai comandi TRATTEGGIO e CONTORNI. 0 Regione 1 polilinea
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(prompt "\n ") (prompt "\n ")
(IF (= "S" (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 1 1))
(progn
(setq diam (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 7 3))
(cond
( (= diam "315") (setq passo (* scala 0.35)) )
)
)
(progn
(setq diam (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 3 3))
(cond
( (= diam "315") (setq passo (* scala 0.35)) )
( (= diam "360") (setq passo (* scala 0.40)) )
( (= diam "405") (setq passo (* scala 0.45)) )
( (= diam "450") (setq passo (* scala 0.50)) )
)
)
)
(IF (= "D" (substr (dcl-Control-GetText Cobiax/Main/tipo_alleggerimento) 1 1))
(progn
(setq diam "315"
passo (* scala 0.365))
)
)
(setq Dcon (/ passo 2.)) ;raggio della sfera?
(setq Dcon* (* scala 1000.0))
(setq p_or (getpoint "\nOrigine Campitura ")) ;punto origine campitura
(setq d2 (* scala (/ (atof diam) 2000.0))) ;boh?!
(setq p_or (mapcar '+ p_or (list Dcon Dcon 0.0))) ;sposto il punto dal vertice all'interno così da avere una sfera interna
(setq p (getpoint "\nPunto Interno "))
(setvar 'hporigin p_or) ;setta l'origine della capitura al punto individuato
(setvar 'hpbound 1) ;Controlla il tipo di oggetto creato dai comandi TRATTEGGIO e CONTORNI. 0 Regione 1 polilinea
(setq LIN (ssadd))
(setq tot (ssadd))
(setq EL* (entlast))
(_CreateLayer "Bordi" 253 "" 0 0)
(setq OLD_LAYER (getvar 'clayer))
(_SetCLayer "Bordi")
(sblocca_layers)
;;; (command "_-bhatch" "_L" "Bordi" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" passo "_y" p "" )
(command "_-bhatch" "_a" "_r" "_y" "_i" "_y" "" "_p" "_u" "0" passo "_y" p "" ) ;acad 2009
(_SetCLayer OLD_LAYER)
;(setq P_linea (entlast))
(while EL*
(if (setq EL* (entnext EL*)) (ssadd EL* tot))
)
(repeat (setq n (sslength tot))
(setq e1 (ssname tot (setq n (1- n))))
(if (= (cdr (assoc 0 (entget e1))) "HATCH")
(setq ret e1)
(setq cont (cons e1 cont))
)
)
(setq EL (entlast))
(command "_explode" ret)
(setq LIN (ssadd))
(while EL
(if (setq EL (entnext EL)) (ssadd EL LIN))
) ;seleziona le linee
;gruppo di selezione -> lista
(repeat(setq n (sslength LIN))
(setq L1 (cons (ssname LIN (setq n (1- n))) L1))
)
(setq L2 L1)
(mapcar
'(lambda (a)
(mapcar
'(lambda (b)
(ii a b)
)
(setq L2 (cdr L2))
)
)
L1
)
(vl-cmdf "._erase" LIN "")
(setq EL (entlast))
(setq lista_cerchi (list))
(mapcar
'(lambda (x)
(setq lista_cerchi (append lista_cerchi (list
(ENTMAKEX (LIST
'(0 . "CIRCLE")
(cons 8 nome) ;layer
(cons 62 (atoi colore))
(CONS 10 x)
(CONS 40 d2)))
)))
)
Lc
)
)
;*************************************************************************
(defun m_v (va)
(setq varsis '())
(repeat (length va)
(setq varsis (append varsis
(list (cons (car va) (getvar (car va))))
)
)
(setq va (cdr va))
)
)
;*************************************************************************
(defun r_v ()
(repeat (length varsis)
(setvar (caar varsis) (cdar varsis))
(setq varsis (cdr varsis))
)
)
;*************************************************************************
(defun ii (ent1 ent2 / int )
(setq ent1 (vlax-ename->vla-object ent1))
(setq ent2 (vlax-ename->vla-object ent2))
(setq int (vlax-invoke ent1 'IntersectWith ent2 acExtendNone))
(cond (int
(repeat (/ (length int) 3)
(setq Lc (cons (list (car int)(cadr int)(caddr int)) Lc))
(setq int (cdddr int))
)
)
)
)
;*************************************************************************
(defun listavertici ( poly / list_vert)
(mapcar '(lambda (x)
(if (eq (car x) 10)
(setq list_vert (cons (trans (list (cadr x) (caddr x)) 0 1) list_vert))
)
)
(entget poly)
)
list_vert
)
我正在使用OPENDCL，因此如果没有一些更改，您就无法运行代码（如果需要的话，我会这样做）。
这里的想法是创建一个图案填充，将其分解并在交点处插入一个圆。如果圆穿过边界线，它将被删除。
正如你所看到的，它非常慢。。。
谢谢你的帮助！
丹尼斯 这些圆圈代表什么？
你好
它们表示轻质钢筋混凝土板的空心成型器模块的位置。
http://www.ekagroup.com/media/filer_public_thumbnails/filer_public/8e/ab/8eab37f4-5d04-4718-86f5-b9d5f14f9940/2.jpg__0x400_q85_crop-scale_subsampling-2_upscale.jpg 凉的 你的网格总是在0旋转吗？
没有，但我更改了其他角度的全局UCS 一种简单的方法是选择表示内边界的pline，如果需要，可以使用bpoly。边界框柱脚选择我用作第一个圆位置的起点，在我的情况下，它是混凝土面板，在x和Y方向排列，因此它覆盖了所有柱脚，比柱脚稍大，然后非常简单地剪裁/修剪所有外部圆删除它们，再次重新修剪，这次任何接触柱脚的圆都会被删除。该方法用于带圆弧的PLINE。
你需要一点图层控制，所以在修剪时不要抹掉应该留下的东西。这是非常快的代码最初是写像20年前，所以个人电脑当时没有那么快。这是一段我没有版权的代码，我无论如何都需要重做。我想我在poly“WP”中找到的对象上使用了chprop，所以外面就像layer1在layer2里面，只是在更改后删除layer1
我也会考虑使用UCS选择一条边等来定位，这可能在球的位置上更经济。
I did manually all the steps in a new lisp that has not been coded yet.
circle
array circle
chprop wp picked the inside points and changed layer
layiso outside circles and erased
unlayiso
all done.
Ps arcs can be taken into account by making facets when doing Chprop WP to increase accuracy.
这是第1版，我必须添加一些东西并加快制作速度，它只需要一个pline就可以工作，因此，如果你有图像中的对象，只需使用bpoly制作一个内部pline，该pline将被要求提供注释弧在pline中是可以的。这有点慢，但测试时我绕了几千圈。我需要正确地添加控制点，我希望您在运行之前为网格选择一条边作为正方形，因此请执行Bpoly和UCS OB。需要一个trans function ver 2。
; get circles with closed pline example
; By Alan H july 2018
; program starts here
(defun objectswithin ( / obj pt i co-ords xy co-ordsxy rad spc ll ur xmany ymany ss )
(setq obj (vlax-ename->vla-object (car (entsel "\nplease pick pline"))))
(vla-getboundingbox obj 'll 'ur)
(setq ll(vlax-safearray->list ll))
(setq ur (vlax-safearray->list ur))
(setq co-ords (vlax-safearray->list(vlax-variant-value (vlax-get-property obj "Coordinates" ))))
(setq I 0)
(repeat(/ (length co-ords) 2)
(setq xy (list (nth i co-ords)(nth (+ I 1) co-ords) ))
(setq co-ordsxy (cons xy co-ordsxy))
(setq I (+ I 2))
)
(setq pt (getpoint "Pick circle point"))
(setq rad (getreal "Enter radius"))
(setq spc (getreal "Enter spacing"))
(if (not(tblsearch "layer" "tempcircle1") )
(command "-layer" "M" "tempcircle1" "c" 6 "tempcircle1" "")
)
(if (not (tblsearch "layer" "tempcircle2") )
( command "-layer" "M" "tempcircle2" "c" 2 "tempcircle2" "")
)
(setq oldlay (getvar 'clayer))
(setvar 'clayer "tempcircle1")
(setq ll (list (- (car ll) rad) (- (cadr ll) rad)))
(setq ur (list (+ (car ur) rad) (+ (cadr ur) rad)))
(setq xmany (fix (/ (- (car ur)(car ll)) spc)))
(setq ymany (fix(/ (- (cadr ur)(cadr ll)) spc)))
(command"circle" ll rad)
(setqobj2 (entlast))
(command "-array"obj2 """R" ymany xmany spc spc )
; selection set of circles within polygon
(setq ss (ssget "WP" co-ordsxy (list (cons 0 "Circle"))))
(princ (sslength ss)) ; this is howmany Circles
(command "chprop" ss "" "la" "tempcircle2" "")
(command "layiso" obj2 "")
(command "erase" "w" (getvar 'extmin)(getvar 'extmax) "")
(command "layuniso" )
(setvar 'clayer oldlay)
)
(objectswithin)
（用我的眼睛）眨了几下眼睛，它是怎么工作的，但后来灯亮了：-）可能有更多的路通往罗马，但我认为你做得很好，比格尔！ 现在在UCS版本上工作，因为它是带钢筋的混凝土，所以会有一条边，你可以从边开始，另一项是你指定圆的起点，在上面的图像中，你说reo在200x200，一个球，然后每隔200mm，所以需要一个定义网格图案的起点。此外，将entmake视为阵列速度非常慢，与手动相比，不确定原因。发现边界框必须在UCS中转换的问题。找到翻译的代码，代码很长。因此，只需在pline上使用最小-最大例程，因为它将在当前UCS内工作。
页:
[1]
2