Code Red > XDRX-API
[XDrX-PlugIn(164)] Smart Centerline
(1/1)
xdcad:
https://www.cadtutor.net/forum/topic/70412-multiple-centerlines-rectangle/
--- Code: ---(defun c:xdtb_zxx (/ #length _pi2 an box centroid dashlength dist1 dist2 e ep1 ep2 hxl hyl info
majoraxis mid1 mid2 minor p p1 p2 p3 p4 pcen pts radius scl sp sp1 sp2 ss temp
typ v1 v2 x xl yl
)
(setq _pi2 (/ pi 2))
(defun mkmark (p an xl yl / hxl hyl p1 p2 p3 p4)
(setq hxl (* 1.4 xl)
hyl (* 1.4 yl)
p1 (polar p an hxl)
p2 (polar p (+ an pi) hxl)
p3 (polar p (+ an _pi2) hyl)
p4 (polar p (- an _pi2) hyl)
)
(xdrx_line_make p1 p2)
(xdrx_setpropertyvalue
(entlast)
"layer"
(xdrx-string-multilanguage "中心线" "CenterLine")
"linetypescale"
scl
)
(xdrx_line_make p3 p4)
(xdrx_setpropertyvalue
(entlast)
"layer"
(xdrx-string-multilanguage "中心线" "CenterLine")
"linetypescale"
scl
)
)
(defun Polyline_center (e / info pts p1 p2 p3 p4 sp radius)
(setq info (xdrx_curve_info e)
pts (xd::list:removedup (xdrx_getpropertyvalue e "vertices"))
)
(cond ((XD::Polyline:IsRectang e)
(mapcar 'set '(p1 p2 p3 p4) pts)
(setq dist1 (distance p1 p2)
dist2 (distance p2 p3)
scl (/ (* 0.4 (min dist1 dist2)) dashlength)
)
(mkmark (cadr (assoc "Centroid" info))
(angle p1 p2)
(* (distance p1 p2) 0.5)
(* (distance p2 p3) 0.5)
)
)
((XD::Polyline:isRegularPolygon e)
(setq pcen (cadr (assoc "Centroid" (xdrx_curve_info e)))
sp (xdrx_curve_getstartpoint e)
radius (distance sp pcen)
scl (/ (* 0.8 radius) dashlength)
)
(mkmark Pcen (angle pcen sp) radius radius)
)
(t (other_center e))
)
)
(defun other_center (e / info centroid box)
(setq info (xdrx_curve_info e)
centroid (cadr (assoc "Centroid" info))
box (mapcar 'abs
(apply 'mapcar (cons '- (cdr (assoc "Box" info))))
)
scl (/ (* 0.4 (car box)) dashlength)
)
(mkmark centroid 0. (* 0.5 (car box)) (* 0.5 (car box)))
)
(defun _istwo (ss)
(and (xdrx_object_iskindof (ssname ss 0) "LINE")
(xdrx_object_iskindof (ssname ss 1) "LINE")
)
)
;;main program
(if (and (setq ss
(xdrx_ssget
(xdrx-string-multilanguage
"\n选择Line,*Polyline,Arc,Circle,Ellipse,Region<退出>:"
"\nSelect Line,*Polyline,Arc,Circle,Ellipse,Region<Exit>:"
)
'((0 . "line,*polyline,arc,circle,ellipse,region"))
)
)
)
(progn (xdrx_begin)
(setq scl 1.0)
(xdrx_layer_make (xdrx-string-multilanguage "中心线" "CenterLine") 6 "ACAD_ISO10W100")
(setq dashlength (xdrx_linetype_dashlengthat "ACAD_ISO10W100" 0))
(if (and (= (sslength ss) 2) (_istwo ss))
(progn (setq sp1 (xdrx_curve_getstartpoint (ssname ss 0))
ep1 (xdrx_curve_getendpoint (ssname ss 0))
)
(if (< (car ep1) (car sp1))
(setq temp ep1
ep1 sp1
sp1 temp
)
)
(setq v1 (xdrx_vector_normalize (mapcar '- ep1 sp1))
sp2 (xdrx_curve_getstartpoint (ssname ss 1))
ep2 (xdrx_curve_getendpoint (ssname ss 1))
)
(if (< (car ep2) (car sp2))
(setq temp ep2
ep2 sp2
sp2 temp
)
)
(setq v2 (xdrx_vector_normalize (mapcar '- ep2 sp2)))
(setq mid1 (xdrx_midp sp1 sp2)
mid2 (xdrx_midp ep1 ep2)
)
(xdrx_line_make mid1 mid2)
(xdrx_getpropertyvalue (entlast) "length")
(setq scl (/ #length 8.0 dashlength))
(xdrx_setpropertyvalue
(entlast)
"layer"
(xdrx-string-multilanguage "中心线" "CenterLine")
"linetypescale"
scl
)
)
(progn
(mapcar '(lambda (x / typ radius majoraxis)
(setq typ (xdrx_getpropertyvalue x "IsA"))
(cond ((wcmatch typ "AcDbCircle,AcDbArc")
(setq radius (xdrx_getpropertyvalue x "Radius")
scl (/ (* 0.8 radius) 12.0)
)
(mkmark (xdrx_getpropertyvalue x "Center") 0. radius radius)
)
((= typ "AcDbEllipse")
(setq majoraxis (xdrx_getpropertyvalue x "MajorAxis")
minor (xdrx_vector_length (xdrx_getpropertyvalue x "MinorAxis"))
scl (/ (* 0.8 minor) dashlength)
)
(mkmark (xdrx_getpropertyvalue x "Center")
(angle '(0. 0.) Majoraxis)
(xdrx_vector_length Majoraxis)
minor
)
)
((= typ "AcDbPolyline") (polyline_center x))
((not (= typ "AcDbLine")) (other_center x))
)
)
(xdrx_pickset->ents ss)
)
)
)
(xdrx_end)
)
)
(princ)
)
--- End code ---
Navigation
[0] Message Index
Go to full version