将圆图元转换为多段线的方法。
(vl-load-com)
(defun circ2poly
(obj / ctr radio a b c d pts vla_poly color_use space)
(if (wcmatch (getvar "acadver") "16*,17*,18*")
(setq color_use (vla-get-colorindex (vla-get-truecolor obj))))
(if (wcmatch (getvar "acadver") "15*")
(setq color_use (vla-get-color obj)))
(setq ctr (vlax-get obj 'center))
(setq radio (vlax-get obj 'radius))
(setq a (polar ctr pi radio))
(setq b (polar ctr 0.0 radio))
(setq c (polar ctr (* pi 0.5) radio))
(setq d (polar ctr (* pi 1.5) radio))
(setq pts (mapcar '2dpt (list a b)))
(setq
space (vla-objectidtoobject
(vla-get-database obj)
(vla-get-ownerid obj)))
(if (not (vl-catch-all-error-p
(setq vla_poly
(vl-catch-all-apply
'vla-addlightweightpolyline
(list space
(lstVariantarray (apply 'append pts)))))))
(vla-put-closed vla_poly t))
(vla-setbulge
vla_poly
0
(getBulge a c b))
(vla-setbulge
vla_poly
1
(getBulge b d a))
(putColor vla_poly color_use)
vla_poly)
(defun 2dpt(pt)
(if (caddr pt)
(list (car pt) (cadr pt))
pt))
(defun putColor(obj color_use)
(if (wcmatch (getvar "acadver") "16*,17*,18*")
(setq vla_truecolor
(vla-getinterfaceobject
(vlax-get-acad-object)
(cond
((wcmatch (getvar "acadver") "16*")
"AutoCAD.AcCmColor.16")
((wcmatch (getvar "acadver") "17*")
"AutoCAD.AcCmColor.17")
((wcmatch (getvar "acadver") "18*")
"AutoCAD.AcCmColor.18")))))
(if (wcmatch (getvar "acadver") "16*,17*,18*")
(progn
(vla-put-colorindex
vla_truecolor
color_use)
(if obj
(vla-put-truecolor obj vla_truecolor)))
(if (wcmatch (getvar "acadver") "15*")
(vla-put-color obj color_use)))
(vlax-release-object vla_truecolor)
(setq vla_truecolor nil))
(defun lstVariantarray(ptslist / arrayspace sarray)
(setq arrayspace
(vlax-make-safearray
vlax-vbdouble
(cons 0
(- (length ptslist) 1))))
(setq sarray (vlax-safearray-fill arrayspace ptslist))
(vlax-make-variant sarray))
(defun getBulge(fromvertex midp p2 / ang chord midc alt)
(setq ang (angle fromvertex p2)
chord (distance fromvertex p2)
midc(polar fromvertex ang (* chord 0.5))
alt (distance midp midc))
(cond
((zerop chord) 0.0)
((equal (angle midp midc)
(rem (+ ang (* pi 0.5)) (* pi 2))
1e-4)
(/ alt chord 0.5))
(t (/ alt chord -0.5))))
(defun ss2lst(ss / i lst)
(setq i (if ss
(1- (sslength ss))
-1))
(while (>= i 0)
(setq lst (cons
(vlax-ename->vla-object
(ssname ss i))
lst)
i (1- i)))
lst)
;; single
(defun C:SCIRC2POLY(/ obj)
(setq
obj (vlax-ename->vla-object (car (entsel "\nSelect Circle: "))))
(circ2poly obj))
;; multiple
(defun C:MCIRC2POLY(/ ss lst)
(if (setq ss (ssget '((0 . "CIRCLE"))))
(progn
(setq lst (ss2lst ss))
(foreach obj lst (circ2poly obj))))
(princ))
(princ)
页:
1
[2]