0 Members and 1 Guest are viewing this topic.
(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))