Hello,
I'm trying to draw a extensionline as a line-object.
My routine (see attachment) askes for selecting a dim-object and the nearest "extension"line will be added. Select it again and is will disappear. I'm not trying to change DIMSE1 or DIMSE2, because my "extension"line has an other linetype !
But my problem is when a mirror the dim-objects.
Something goes wrong with the nearest "extension"line.
Can onyone please help me?
Martin
;;; Filename: dimextline.lsp
;;; Routine om de aanhaallijn van een maatlijn (= extensionline) aan/uit te zetten ;;; Routine is UCS-onafhankelijk, maar werkt nog niet helemaal goed indien geen UCS World.
;;; Oude methode:
;;; Teken een lijn van een maatlijn naar een definitie-punt naar keuze. ;;; De lijn wordt in dezelfde laag gezet als de maatlijn. ;;; De kleur van de lijn is geel (kleur: 2) met lijntype DOT2
;;; Nieuwe methode:
;;; veranderd variabele DIMSE1 of DIMSE2, afhankelijk waar men op de maatlijn selecteerd. ;;; veranderd variabele DIMEXO op nul millimeter
;;; Instelling #dimextline: zie bestand setup-dim.lsp
;;; 2003: 4 uur
;;; ---
;;; (14) O O (13)
;;; | |
;;; | |
;;; | maat |
;;; (bpt) O----------O (ept)
;;; bpt in WCS = (fld 10 ed)
;;; ept in WCS = niet aanwezig in database
;;; hoek = (angle bpt ept) = (fld 50 ed)
;;; dimse1 = onderdruk 1e extensielijn
;;; dimse2 = onderdruk 2e extensielijn
(vl-load-com)
(setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object)) acadUtil (vla-get-Utility acadDoc)
)
(defun FLD (@groupcode @lijst)
(cond
((= (type @lijst) 'VLA-OBJECT)
(setq @lijst (entget (vlax-vla-object->ename @lijst))) ; [VLA-OBJECT] ) ((= (type @lijst) 'ENAME) (setq @lijst (entget @lijst)) ; [ENAME] ) ((and (listp @lijst) (= (type (car @lijst)) 'ENAME)) (setq @lijst (entget (car @object))) ; entsel of nentsel ) ((= (type @lijst) 'LIST) (setq @lijst @lijst) ;
I'm trying to draw a extensionline as a line-object.
My routine (see attachment) askes for selecting a dim-object and the nearest "extension"line will be added. Select it again and is will disappear. I'm not trying to change DIMSE1 or DIMSE2, because my "extension"line has an other linetype !
But my problem is when a mirror the dim-objects.
Something goes wrong with the nearest "extension"line.
Can onyone please help me?
Martin
;;; Filename: dimextline.lsp
;;; Routine om de aanhaallijn van een maatlijn (= extensionline) aan/uit te zetten ;;; Routine is UCS-onafhankelijk, maar werkt nog niet helemaal goed indien geen UCS World.
;;; Oude methode:
;;; Teken een lijn van een maatlijn naar een definitie-punt naar keuze. ;;; De lijn wordt in dezelfde laag gezet als de maatlijn. ;;; De kleur van de lijn is geel (kleur: 2) met lijntype DOT2
;;; Nieuwe methode:
;;; veranderd variabele DIMSE1 of DIMSE2, afhankelijk waar men op de maatlijn selecteerd. ;;; veranderd variabele DIMEXO op nul millimeter
;;; Instelling #dimextline: zie bestand setup-dim.lsp
;;; 2003: 4 uur
;;; ---
;;; (14) O O (13)
;;; | |
;;; | |
;;; | maat |
;;; (bpt) O----------O (ept)
;;; bpt in WCS = (fld 10 ed)
;;; ept in WCS = niet aanwezig in database
;;; hoek = (angle bpt ept) = (fld 50 ed)
;;; dimse1 = onderdruk 1e extensielijn
;;; dimse2 = onderdruk 2e extensielijn
(vl-load-com)
(setq acadDoc (vla-get-ActiveDocument (vlax-get-acad-object)) acadUtil (vla-get-Utility acadDoc)
)
(defun FLD (@groupcode @lijst)
(cond
((= (type @lijst) 'VLA-OBJECT)
(setq @lijst (entget (vlax-vla-object->ename @lijst))) ; [VLA-OBJECT] ) ((= (type @lijst) 'ENAME) (setq @lijst (entget @lijst)) ; [ENAME] ) ((and (listp @lijst) (= (type (car @lijst)) 'ENAME)) (setq @lijst (entget (car @object))) ; entsel of nentsel ) ((= (type @lijst) 'LIST) (setq @lijst @lijst) ;
- ) ) (if (and (= @groupcode 40) (= (cdr (assoc 0 @lijst)) "DIMSTYLE")) ; (if (or (null (cdr (assoc 40 @lijst))) (zerop (cdr (assoc 40 @lijst)))) (if (null (cdr (assoc 40 @lijst)))
1.0
(cdr (assoc @groupcode @lijst))
)
(cdr (assoc @groupcode @lijst))
)
)
(defun vlm:Array->List (@Array)
(if (and @Array (safearray-value (vlax-variant-value @Array))) (vlax-safearray->list (vlax-variant-value @Array)) ' )
)
(defun vlm
imExtline (/ bpt e1 ed ept fl fld6 hoek ly n pt ss1 ss2 vla-obj xx) (setvar "CMDECHO" acOff) ; (vlm:LoadLinetype "DOT2") ; is lijntype beschikbaar? (setq clay (getvar "CLAYER") e1 (entsel "\nSelecteer een zijde: ") fld6 "DOT2" ; linetype ) (while e1 (setq pt (trans (cadr e1) acUCS acWorld) vla-obj (vlax-ename->vla-object (car e1)) ) (if (wcmatch (vla-get-ObjectName vla-obj) "AcDbRotatedDimension,AcDbAlignedDimension") (progn (vla-StartUndoMark acadDoc) (setq #sp_mark 1) (if (minusp (- (angle (fld 14 (car e1)) (fld 13 (car e1))) (angle (fld 14 (car e1)) (fld 10 (car e1))))) (setq check T) (setq check nil) ) ;; (cadr e1) = prik punt in UCS ;; field 10 = WCS-point ;; field 13 = WCS-point for linear and angular dimensions ;; field 14 = WCS-point for linear and angular dimensions (setq bpt (fld 10 (car e1))) (setq ept (vlm:Array->List (vla-PolarPoint acadUtil (vlax-3d-point bpt) (if (null check) (+ (angle bpt (fld 14 (car e1))) (/ pi 2.0)) (- (angle bpt (fld 14 (car e1))) (/ pi 2.0)) ) (vla-get-Measurement vla-obj) ) ) ) (if (< (distance pt ept) (distance pt bpt)) (setq xx (list (trans ept acWorld acUCS) (fld 13 (car e1)))) ; 1e extensielijn (setq xx (list bpt (fld 14 (car e1)))) ; 2e extensielijn ) (setq ss1 (ssget "X" (list (cons -4 "<AND") (cons 0 "LINE") (cons 6 fld6) (cons -4 "<OR") (cons 10 (car xx)) (cons 10 (cadr xx)) (cons -4 "OR>") (cons -4 "<OR") (cons 11 (car xx)) (cons 11 (cadr xx)) (cons -4 "OR>") (cons -4 "AND>") ) ) ) (if ss1 (progn (setq n 0 ss2 (ssadd) ) (repeat (sslength ss1) (setq e1 (ssname ss1 n) ly (fld 8 e1) fl (fld 70 (tblsearch "LAYER" ly)) ) (if (or (= fl 0) (= fl 4)) (ssadd e1 ss2) ) ; wis object van selectieset ss1 (setq n (1+ n)) ) (if ss2 (progn ; alleen objecten waarvan de laag aan en eventueel gelocked is (setq e1 (ssname ss2 0) ly (fld 8 e1) fl (fld 70 (tblsearch "LAYER" ly)) ) (command "._LAYER" "UNLOCK" ly "") (ssdel e1 ss2) ; wis object van selectieset ss1 (entdel e1) ; wis zichtbaar object van tekening (prompt "\nWis aanhaallijn.") (if (= fl 4) (command "._LAYER" "LOCK" ly "") ) ) ) ) (progn ; teken lijn (entmake (list (cons 0 "LINE") ; object-type (cons 6 fld6) ; lijntype (cons 8 (fld 8 (car e1))) ; laag (cons 10 (car xx)) ; WCS-eindpunt (cons 11 (cadr xx)) ; WCS-definitiepunt (cons 48 1.0) ; linetype scale (cons 62 acYellow) ; kleurnr ) ) (prompt (strcat "\nTeken aanhaal in laag " (fld 8 (car e1)) " met lijntype " fld6 ) ) ) ; einde progn ) ; einde if ss1 (setq #sp_mark nil) (vla-EndUndoMark acadDoc) ) ; einde progn (prompt " object is geen lineair dim-object.") ) ; einde if e1 (setq e1 (entsel "\nSelecteer een zijde: ")) ) (princ)
)
(princ)
;|«Visual LISP© Format Options»
(120 2 2 2 nil "end of " 100 120 0 0 2 nil T nil T)
;*** DO NOT add text below the comment! ***|;
