Topic: [XDrX-PlugIn(164)] Smart Centerline

[xdcad]

https://www.cadtutor.net/forum/topic/70412-multiple-centerlines-rectangle/

Code: [Select]

(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)
)