;;;=====================================================================================
(defun polylinedims (/ *error* dtr rtd getdimlayer dimpl entname entpick)
(vl-load-com)
(defun *error* (msg)
(vl-bt)
(if
(not
(member msg
(list
"Function cancelled"
"console break"
"quit / exit abort"
)
)
)
(princ (strcat "\nError: " msg))
)
(if clayer (setvar "clayer" clayer))
(if osmode (setvar "osmode" osmode))
(if cmdecho (setvar "cmdecho" cmdecho))
(command "_.undo" "_end")
(princ)
)
(defun dtr (angle_en_degrés)(/ (* angle_en_degrés pi) 180.0))
(defun rtd (angle_en_radians)(/ (* angle_en_radians 180.0) pi))
(defun convertpoly (ent / objname coords lst)
(if ent
(progn
(setq objname
(vlax-get
(setq obj (vlax-ename->vla-object ent))
'ObjectName
)
)
(setq coords (vlax-get obj 'Coordinates))
(if (= objname "AcDb2dPolyline")
(repeat (/ (length coords) 3)
(setq lst
(append lst
(list (car coords) (cadr coords))
)
)
(setq coords (cdddr coords))
)
(setq lst coords)
)
)
)
(vla-delete obj)
(vlax-invoke
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
'addLightWeightPolyline
(append
lst
(list (car lst) (cadr lst))
)
)
)
(defun getdimlayer (/ dimlayer entlist index layer layerinfo layerlst lst num sset)
(setq layer (getvar "clayer"))
(if (setq sset (ssget "x" '((0 . "DIMENSION"))))
(progn
(setq index -1)
(while (< (setq index (1+ index)) (sslength sset))
(setq
entlist (entget (ssname sset index))
dimlayer (cdr (assoc 8 entlist))
layerinfo (tblsearch "layer" dimlayer)
)
(if (and (= (cdr (assoc 70 layerinfo)) 0)(> (cdr (assoc 62 layerinfo)) 0))
(if (assoc dimlayer layerlst)
(setq
num (1+ (cdr (assoc dimlayer layerlst)))
layerlst (subst (cons dimlayer num) (assoc dimlayer layerlst) layerlst)
)
(setq layerlst (append layerlst (list (cons dimlayer 1))))
)
)
)
(if Layerlst
(progn
(setq
layer (car (car Layerlst))
num (cdr (car Layerlst))
)
(foreach lst (cdr Layerlst)
(if (> (cdr lst) num)
(setq
layer (car lst)
num (cdr lst)
)
)
)
)
)
)
)
layer
)
(defun dimpl (entname / bottom clayer cw diffang dimpts dimspace entlist item
lastang lastpt left lst nw osmode p0 p1 p2 pt pts ptslen
right se top x x1 x1y1 x1y2 x1ys x2 x2y1 x2y2 x2ys xpts
y y1 y1x1 y1x2 y1xs y2 y2x1 y2x2 y2xs ypts)
(defun dimpts (pts startpt endpt type / add num1 num2 nums1 nums2 p1 p2 pt return)
(setq add t)
(foreach pt (member startpt (append pts pts))
(if add
(setq return (append return (list Pt)))
)
(if (equal pt endpt)
(setq add nil)
)
)
(foreach pt return
(if (member type (list "Left" "Right"))
(setq nums1 (append nums1 (list (cadr pt))))
(setq nums1 (append nums1 (list (car pt))))
)
)
(foreach num1 (vl-sort nums1 '<)
(setq nums2 nil)
(foreach pt return
(if (member type (list "Left" "Right"))
(if (= (cadr pt) num1)
(setq nums2 (append nums2 (list (car pt))))
)
(if (= (car pt) num1)
(setq nums2 (append nums2 (list (cadr pt))))
)
)
)
(if (member type (list "Left" "Bottom"))
(setq nums2 (vl-sort nums2 '<))
(setq nums2 (reverse (vl-sort nums2 '<)))
)
(foreach num2 (cdr nums2)
(if (member type (list "Left" "Right"))
(setq pt (list num2 num1))
(setq pt (list num1 num2))
)
(setq return (vl-remove Pt return))
)
)
(cond
((= type "Left")
(vl-sort return (function (lambda (p1 p2)(< (cadr p1)(cadr p2)))))
)
((= type "Top")
(vl-sort return (function (lambda (p1 p2)(< (car p1)(car p2)))))
)
((= type "Right")
(vl-sort return (function (lambda (p1 p2)(> (cadr p1)(cadr p2)))))
)
((= type "Bottom")
(vl-sort return (function (lambda (p1 p2)(> (car p1)(car p2)))))
)
)
)
(if (= (cdr (assoc 0 (entget entname))) "POLYLINE")
(setq entname (vlax-vla-object->ename (convertpoly entname)))
)
(setq entlist (entget entname))
(foreach lst entlist
(if (= (car lst) 10)
(if (not (equal (cdr lst) lastpt))
(progn
(setq pts (append pts (list (cdr lst))))
(if (> (length pts) 2)
(if (/= (angle lastpt (cdr lst)) lastang) (setq diffang t))
)
(if (> (length pts) 1)
(setq lastang (angle lastpt (cdr lst)))
)
(setq lastpt (cdr lst))
)
)
)
)
(if (equal (car pts) (last pts))
(setq pts (reverse (cdr (reverse pts))))
)
(setq ptslen (length pts))
(foreach pt pts
(setq
x (atof (rtos (car Pt) 2 8))
y (atof (rtos (cadr Pt) 2 8))
xpts (append xpts (list x))
ypts (append ypts (list y))
pts (cdr (append pts (list (list x y))))
)
)
(setq
xpts (vl-sort xpts '<)
ypts (vl-sort ypts '<)
x1 (car xpts)
x2 (last xpts)
y1 (car ypts)
y2 (last ypts)
)
(foreach pt pts
(if (= (car pt) x1) (setq x1ys (append x1ys (list (cadr pt)))))
(if (= (car pt) x2) (setq x2ys (append x2ys (list (cadr pt)))))
(if (= (cadr pt) y1) (setq y1xs (append y1xs (list (car pt)))))
(if (= (cadr pt) y2) (setq y2xs (append y2xs (list (car pt)))))
)
(setq
x1ys (vl-sort x1ys '<)
x2ys (vl-sort x2ys '<)
y1xs (vl-sort y1xs '<)
y2xs (vl-sort y2xs '<)
x1y1 (list x1 (car x1ys))
x1y2 (list x1 (last x1ys))
x2y1 (list x2 (car x2ys))
x2y2 (list x2 (last x2ys))
y1x1 (list (car y1xs) y1)
y1x2 (list (last y1xs) y1)
y2x1 (list (car y2xs) y2)
y2x2 (list (last y2xs) y2)
pts (member x1y1 (append pts pts))
)
(while (> (length pts) PtsLen)
(setq pts (reverse (cdr (reverse pts))))
)
(setq se (member X2Y2 pts) nw pts)
(foreach item se
(setq nw (vl-remove item nw))
)
(setq
se (append se (list X1Y1))
nw (append nw (list X2Y2))
cw 0
)
(foreach pt (list y2x1 y2x2)
(if (member pt nw) (setq cw (1+ cw)))
(if (member pt se) (setq cw (1- cw)))
)
(foreach pt (list y1x1 y1x2)
(if (member pt se) (setq cw (1+ cw)))
(if (member pt nw) (setq cw (1- cw)))
)
(if (< cw 0)(setq pts (append (list (car pts))(reverse (cdr pts)))))
(setq left (dimpts pts y1x1 y2x1 "Left"))
(setq top (dimpts pts x1y2 x2y2 "Top"))
(setq right (dimpts pts y2x2 y1x2 "Right"))
(setq bottom (dimpts pts x2y1 x1y1 "Bottom"))
(command "_.undo" "_begin")
(setq dimspace (* (getvar "dimscale") (getvar "dimtxt") 3))
(setq osmode (getvar "osmode"))
(setvar "osmode" 0)
(setq clayer (getvar "clayer"))
(command "_.layer" "_s" (getdimlayer) "")
(setvar "dimtix" 1)
(setq
p0 (polar x1y1 pi (* dimspace 1.5))
p1 (car left)
)
(foreach p2 (cdr left)
(command "_.dim1" "_ver" p1 p2 p0 "")
(setq p1 p2)
)
(if (> (length left) 2)
(progn
(setq P0 (polar P0 pi dimspace))
(command "_.dim1" "_ver" (car left) (last left) p0 "")
)
)
(setq
p0 (polar y2x1 (dtr 90) (* dimspace 1.5))
P1 (car top)
)
(foreach P2 (cdr top)
(command "_.dim1" "_hor" p1 p2 p0 "")
(setq p1 p2)
)
(if (> (length top) 2)
(progn
(setq p0 (polar p0 (dtr 90) dimspace))
(command "_.dim1" "_hor" (car top) (last top) p0 "")
)
)
(setq
p0 (polar x2y2 0 (* dimspace 1.5))
p1 (car right)
)
(if (and (> (length right) 2) diffang)
(foreach p2 (cdr right)
(command "_.dim1" "_ver" p1 p2 p0 "")
(setq p1 p2)
)
)
(setq
p0 (polar y1x2 (dtr 270) (* dimspace 1.5))
p1 (car bottom)
)
(if (and (> (length bottom) 2) diffang)
(foreach P2 (cdr bottom)
(command "_.dim1" "_hor" p1 p2 p0 "")
(setq P1 P2)
)
)
(setvar "clayer" clayer)
(setvar "osmode" osmode)
(command "_.undo" "_end")
(princ)
)
(setq cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (setq entpick (entsel "\nSelect polyline: "))
(if (wcmatch (cdr (assoc 0 (entget (car entpick)))) "*POLYLINE")
(progn
(setq entname (car entpick))
(dimpl entname)
)
(princ "\nNo polyline selected.")
)
(princ "\nNothing selected.")
)
(setvar "cmdecho" cmdecho)
(princ)
)
;;;=====================================================================================
(defun c:pld ()(polylinedims)(princ))
;;;=====================================================================================
(prompt "\n *** PLINEDIM.LSP loaded. Type 'PLD' to run the program. *** ")
;;;=====================================================================================
(princ)
;;;=====================================================================================
