TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: dussla on November 11, 2010, 07:12:41 AM

Title: rectangle auto dimension
Post by: dussla on November 11, 2010, 07:12:41 AM
hi
firend . how are you these days?
always good luck

i need some help.
that is     rectangle  auto dimension .
there is many  rectangles .  i have to dimension  about that.

dim letter posion  is     vertical  left  and  horizon  top
is that possible ?
thank you always    ..
good day , good luck
Title: Re: rectangle auto dimension
Post by: HasanCAD on November 11, 2010, 07:44:32 AM
Give this a try

Code: [Select]
`(defun c:test(/ p1 p2 p3 p4 p5);@ LEE  (setq p1 (getpoint "\nPick Center point."))  (setq p2 (getpoint "\nPick Corner point."))  (setq p3 (list (max (car p1)(car p2))(max (cadr p1)(cadr p2))))  (setq p4 (list (min (car p1)(car p2))(max (cadr p1)(cadr p2))))  (setq p5 (list (min (car p1)(car p2))(min (cadr p1)(cadr p2))))  (setq p6 (list (- (min (car p3)(car p4)) 400)(+ 400 (max (cadr p4)(cadr p5)))))  (command "_.dimlinear" "_non" p3 "_non" p4 "_non" (polar p3 (/ pi 2.) 400) )  (command "_.dimlinear" "_non" p4 "_non" p5 "_non" (polar p5 pi 400) )  (entmakex (list (cons 0 "TEXT") ;***                   (cons 1 "My Text") ;* the string                  (cons 40 (getvar "textsize")) ;* Text height                  (cons 10 p6)))  (princ))`
Title: Re: rectangle auto dimension
Post by: xiaxiang on November 11, 2010, 07:45:48 AM
Maybe you can use "qdim"
Title: Re: rectangle auto dimension
Post by: HasanCAD on November 11, 2010, 08:40:36 AM
And this one

Code: [Select]
`;-------------------------------------------------------------------------------; Program Name: DPL - Dimension Polylines; Created By:   Terry Miller (Email: terrycadd@yahoo.com);               (URL: http://web2.airmail.net/terrycad); Date Created: 5-20-08; Function:     Dimensions Polyline shapes;-------------------------------------------------------------------------------; Revision History; Rev  By     Date    Description;-------------------------------------------------------------------------------; 1    TM   5-20-08   Initial version;-------------------------------------------------------------------------------; c:DPL - Dimensions Polyline;-------------------------------------------------------------------------------(defun c:DPL (/ EntName^ EntPick@)  (setvar "CMDECHO" 0)  (if (setq EntPick@ (entsel "\nSelect Polyline to dimension: "))    (if (= (cdr (assoc 0 (entget (car EntPick@)))) "LWPOLYLINE")      (progn        (setq EntName^ (cdr (assoc -1 (entget (car EntPick@)))))        (DimPL EntName^)      );progn    );if  );if  (if (not EntName^)    (princ "\nNo Polyline selected.")  );if  (princ));defun c:DPL;-------------------------------------------------------------------------------; DimPL - Function to dimension Polyline; Arguments: 1;   EntName^ = Polyline entity name; Returns: Dimensions Polyline;-------------------------------------------------------------------------------(defun DimPL (EntName^ / Bottom@ Clayer\$ CW# DiffAng DimPts: DimSpace~ EntList@  Item LastAng~ LastPt Left@ List@ 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      (if (equal Pt EndPt)        (setq Add nil)      );if    );foreach    (foreach Pt Return@      (if (member Type\$ (list "Left" "Right"))        (setq Nums1@ (append Nums1@ (list (cadr Pt))))        (setq Nums1@ (append Nums1@ (list (car Pt))))      );if    );foreach    (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          (if (= (car Pt) Num1~)            (setq Nums2@ (append Nums2@ (list (cadr Pt))))          );if        );if      );foreach      (if (member Type\$ (list "Left" "Bottom"))        (setq Nums2@ (vl-sort Nums2@ '<))        (setq Nums2@ (reverse (vl-sort Nums2@ '<)))      );if      (foreach Num2~ (cdr Nums2@)        (if (member Type\$ (list "Left" "Right"))          (setq Pt (list Num2~ Num1~))          (setq Pt (list Num1~ Num2~))        );if        (setq Return@ (vl-remove Pt Return@))      );foreach    );foreach    (cond      ((= Type\$ "Left")        (vl-sort Return@ (function (lambda (P1 P2)(< (cadr P1)(cadr P2)))))      );case      ((= Type\$ "Top")        (vl-sort Return@ (function (lambda (P1 P2)(< (car P1)(car P2)))))      );case      ((= Type\$ "Right")        (vl-sort Return@ (function (lambda (P1 P2)(> (cadr P1)(cadr P2)))))      );case      ((= Type\$ "Bottom")        (vl-sort Return@ (function (lambda (P1 P2)(> (car P1)(car P2)))))      );case    );cond  );defun DimPts:  ;-----------------------------------------------------------------------------  (setq EntList@ (entget EntName^))  (if (= (cdr (assoc 0 EntList@)) "LWPOLYLINE")    (progn      (foreach List@ EntList@        (if (= (car List@) 10)          (if (not (equal (cdr List@) LastPt))            (progn              (setq Pts@ (append Pts@ (list (cdr List@))))              (if (> (length Pts@) 2)                (if (/= (angle LastPt (cdr List@)) LastAng~) (setq DiffAng t))              );if              (if (> (length Pts@) 1)                (setq LastAng~ (angle LastPt (cdr List@)))              );if              (setq LastPt (cdr List@))            );progn          );if        );if      );foreach      (if (equal (car Pts@) (last Pts@))        (setq Pts@ (reverse (cdr (reverse Pts@))))      );if      (setq PtsLen (length Pts@))    );progn    (exit)  );if  (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  );foreach  (setq XPts@ (vl-sort XPts@ '<)        YPts@ (vl-sort YPts@ '<)        X1~ (car XPts@)        X2~ (last XPts@)        Y1~ (car YPts@)        Y2~ (last YPts@)  );if  (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)))))  );foreach  (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@))  );setq  (while (> (length Pts@) PtsLen)    (setq Pts@ (reverse (cdr (reverse Pts@))))  );while  (setq SE@ (member X2Y2 Pts@) NW@ Pts@)  (foreach Item SE@    (setq NW@ (vl-remove Item NW@))  );foreach  (setq SE@ (append SE@ (list X1Y1))        NW@ (append NW@ (list X2Y2))        CW# 0  );setq  (foreach Pt (list Y2X1 Y2X2)    (if (member Pt NW@) (setq CW# (1+ CW#)))    (if (member Pt SE@) (setq CW# (1- CW#)))  );foreach  (foreach Pt (list Y1X1 Y1X2)    (if (member Pt SE@) (setq CW# (1+ CW#)))    (if (member Pt NW@) (setq CW# (1- CW#)))  );foreach  (if (< CW# 0)    (setq Pts@ (append (list (car Pts@))(reverse (cdr Pts@))))  );if  (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) "");<--Change to your Dim layer info  (setq P0 (polar X1Y1 pi (* DimSpace~ 1.5))        P1 (car Left@)  );setq  (foreach P2 (cdr Left@)    (command "DIM1" "VER" P1 P2 P0 "")    (setq P1 P2)  );foreach  (if (> (length Left@) 2)    (progn      (setq P0 (polar P0 pi DimSpace~))      (command "DIM1" "VER" (car Left@) (last Left@) P0 "")    );progn  );if  (setq P0 (polar Y2X1 (* pi 0.5) (* DimSpace~ 1.5))        P1 (car Top@)  );setq  (foreach P2 (cdr Top@)    (command "DIM1" "HOR" P1 P2 P0 "")    (setq P1 P2)  );foreach  (if (> (length Top@) 2)    (progn      (setq P0 (polar P0 (* pi 0.5) DimSpace~))      (command "DIM1" "HOR" (car Top@) (last Top@) P0 "")    );progn  );if  (setq P0 (polar X2Y2 0 (* DimSpace~ 1.5))        P1 (car Right@)  );setq  (if (and (> (length Right@) 2) DiffAng)    (foreach P2 (cdr Right@)      (command "DIM1" "VER" P1 P2 P0 "")      (setq P1 P2)    );foreach  );if  (setq P0 (polar Y1X2 (* pi 1.5) (* DimSpace~ 1.5))        P1 (car Bottom@)  );setq  (if (and (> (length Bottom@) 2) DiffAng)    (foreach P2 (cdr Bottom@)      (command "DIM1" "HOR" P1 P2 P0 "")      (setq P1 P2)    );foreach  );if  (setvar "CLAYER" Clayer\$)  (setvar "OSMODE" Osmode#)  (command "UNDO" "END")  (princ));defun DimPL;-------------------------------------------------------------------------------; GetDimLayer - Returns the layer name that's on and has the most dimensions,; or the current layer name if there's no dimensions.;-------------------------------------------------------------------------------(defun GetDimLayer (/ DimLayer\$ EntList@ Index# Layer\$ LayerInfo@ LayerList@ List@ Num# SS&)  (setq Layer\$ (getvar "CLAYER"))  (if (setq SS& (ssget "X" '((0 . "DIMENSION"))))    (progn      (setq Index# -1)      (while (< (setq Index# (1+ Index#)) (sslength SS&))        (setq EntList@ (entget (ssname SS& Index#))              DimLayer\$ (cdr (assoc 8 EntList@))              LayerInfo@ (tblsearch "LAYER" DimLayer\$)        );setq        (if (and (= (cdr (assoc 70 LayerInfo@)) 0)(> (cdr (assoc 62 LayerInfo@)) 0))          (if (assoc DimLayer\$ LayerList@)            (setq Num# (1+ (cdr (assoc DimLayer\$ LayerList@)))                  LayerList@ (subst (cons DimLayer\$ Num#) (assoc DimLayer\$ LayerList@) LayerList@)            );setq            (setq LayerList@ (append LayerList@ (list (cons DimLayer\$ 1))))          );if        );if      );while      (if LayerList@        (progn          (setq Layer\$ (car (car LayerList@))                Num# (cdr (car LayerList@))          );setq          (foreach List@ (cdr LayerList@)            (if (> (cdr List@) Num#)              (setq Layer\$ (car List@)                    Num# (cdr List@)              );setq            );if          );foreach        );progn      );if    );progn  );if  Layer\$);defun GetDimLayer;-------------------------------------------------------------------------------(princ);End of DPL.lsp`
Title: Re: rectangle auto dimension
Post by: xiaxiang on November 12, 2010, 02:47:05 AM
You can also see that.But very slow!
Code: [Select]
`(defun C:test (/ elist en p1 p2 pc ss)  (setvar "osmode" 0)(command "_.zoom" "_e")(setq ss (ssget "_X" (list (cons 0  "LINE"))))(setq i -1)(while  (setq en (ssname ss (setq i (1+ i))))  (setq elist (entget en))  (setq p1 (cdr (assoc 10 elist)) p2 (cdr (assoc 11 elist)) pc (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2) )  (entmake (list (cons 0 "DIMENSION")    (cons 100  "AcDbEntity")    (cons 67 0)    (cons 410  "Model")    (cons 8  "ZONE1")    (cons 100  "AcDbDimension")    (cons 10 (trans (list (car p2)(cadr p2) 0.0) 1 0))    (cons 11 (trans (list (car pc)(cadr pc) 0.0) 1 0))    (cons 12 (list 0. 0. 0.))    (cons 6  "Continuous")    (cons 62 2)    (cons 70  33)    (cons 1  "")    (cons 71  5)    (cons 72  1)    (cons 41  1.0)    (cons 42  (distance p1 p2))    (cons 52 0)    (cons 53 0)    (cons 54  0)    (cons 3  "Standard")    (cons 100  "AcDbAlignedDimension")    (cons 13 (trans (list (car p1)(cadr p1) 0.0) 1 0))    (cons 14 (trans (list (car p2)(cadr p2) 0.0) 1 0))    (cons 15 (list 0. 0. 0.))    (cons 16 (list 0. 0. 0.))   ))  ) (alert "Done?") (princ)  )`
Title: Re: rectangle auto dimension
Post by: Kerry on November 12, 2010, 04:20:35 AM
You can also see that.But very slow!
Code: [Select]
`(defun C:test (/ elist en p1 p2 pc ss) `

:)

fast is better than slow

slow is better than by hand
Title: Re: rectangle auto dimension
Post by: dussla on November 12, 2010, 04:46:20 AM
i tested with rectangles
but that is not work ?
what is problem
pls see atached file .
thank you for good anwser always
Title: Re: rectangle auto dimension
Post by: fixo on November 12, 2010, 08:40:22 AM
Just Q&D without testing:
Code: [Select]
`(defun C:demo (/ centpt coords elist en hgt p1 p2 p3 ss) (command "_.zoom" "_e")  (if (zerop (getvar "dimtxt"))      (setq hgt 2.5)      (setq hgt (getvar "dimtxt")))  (if(setq ss (ssget "_X" (list (cons 0  "LWPOLYLINE")(cons 70  1)(cons 90  4))))(while  (setq en (ssname ss 0))  (setq elist (entget en))  (setq coords (vl-remove-if (function not)(mapcar (function (lambda(x)(if (= 10 (car x))(cdr x))))elist)))  (setq CentPt (mapcar (function (lambda(a b)(/ (+ a b )2)))(car coords )(caddr coords)) ) (setq coords (vl-sort Coords (function (lambda(a b)(> (angle CentPt a)(angle CentPt b))))))  (setq p1 (cadr coords)p2(caddr coords) p3(last coords)) (command "._dimlinear" "_non" p1"_non" p2"_non" (polar p2 pi (* 12 hgt)) )  (command "._dimlinear" "_non" p2"_non" p3"_non" (polar p3 (/ pi 2) (* 12 hgt)) )  (ssdel en ss))(command "_.zoom" "_p")) (princ)  )`
Title: Re: rectangle auto dimension
Post by: CAB on November 12, 2010, 12:46:35 PM
That worked well in my test. 8-)
Title: Re: rectangle auto dimension
Post by: Sam on November 13, 2010, 05:53:32 AM
Just Q&D without testing:
Code: [Select]
`(defun C:demo (/ centpt coords elist en hgt p1 p2 p3 ss) (command "_.zoom" "_e")  (if (zerop (getvar "dimtxt"))      (setq hgt 2.5)      (setq hgt (getvar "dimtxt")))  (if(setq ss (ssget "_X" (list (cons 0  "LWPOLYLINE")(cons 70  1)(cons 90  4))))(while  (setq en (ssname ss 0))  (setq elist (entget en))  (setq coords (vl-remove-if (function not)(mapcar (function (lambda(x)(if (= 10 (car x))(cdr x))))elist)))  (setq CentPt (mapcar (function (lambda(a b)(/ (+ a b )2)))(car coords )(caddr coords)) ) (setq coords (vl-sort Coords (function (lambda(a b)(> (angle CentPt a)(angle CentPt b))))))  (setq p1 (cadr coords)p2(caddr coords) p3(last coords)) (command "._dimlinear" "_non" p1"_non" p2"_non" (polar p2 pi (* 12 hgt)) )  (command "._dimlinear" "_non" p2"_non" p3"_non" (polar p3 (/ pi 2) (* 12 hgt)) )  (ssdel en ss))(command "_.zoom" "_p")) (princ)  )`
Dear Sir
It's work
one more suggeation add selection option
Title: Re: rectangle auto dimension
Post by: fixo on November 13, 2010, 07:19:14 AM
Shortl explanation:
(ssget "_X" (list (cons 0  "LWPOLYLINE");<--entity type
(cons 70  1); <--1 is for closed polyline,0 for opened
(cons 90  4);<--4 is number of vertices
)))

Title: Re: rectangle auto dimension
Post by: CAB on November 13, 2010, 08:58:08 AM
Shortl explanation:
(ssget "_X" (list (cons 0  "LWPOLYLINE");<--entity type
(cons 70  1); <--1 is for closed polyline,0 for opened
(cons 90  4);<--4 is number of vertices
)))

Remove "_X" to allow user to select.
Title: Re: rectangle auto dimension
Post by: fixo on November 13, 2010, 11:42:17 AM
Thanks, Alan :)