;|
dimse.lsp
Michael Weaver
AlasCAD
1073 Badger Road
North Pole, Alaska 99705
Email: mweaver@bettisworth.com
Email: michael.weaver@acsalaska.net
(907)488-3577
(c)2001, 2003 Michael Weaver

Dimension Suppress Extension lines
dimension states   	Extension lines suppressed
0			None
1			First
2			Second
3			Both

Dimension Suppress Arrows
dimension states   	Arrows suppressed
0			None
1			First
2			Second
3			Both

c:dse - Dimension Suppress Extension lines
	Each pick of a dimension cycles through possible combinations
	of supressed extension lines.  Use this to turn off dimension
	extension lines so that underlying centerlines show.

c:dsa - Dimension Suppress Arrows
	Each pick of a dimension cycles through possible combinations
	of suppressed arrows.

c:dsh - Dimension Stack Horizontal toggle
	Toggles stacked horizontal fractions on/off

c:dino- Dimension INches Only toggle
	Toggles dimensions from inches only to feet and inches

c:dwd - Dimension Width Dynamic
	Select a dimension then use the + and - keys on the numeric
	keypad to dynamically decrease and increase the width factor
	for the dimension text.  This width factor is applied as an
	mtext format in the dimension text override.

Revision History
9 June 2001	File creation
May 2003	Added c:dsa, c:dsh, c:dino, c:dwd

|;


(vl-load-com)

(defun c:dimse()
  (alert
"c:dse - Dimension Suppress Extension lines
	Each pick of a dimension cycles through possible combinations
	of supressed extension lines.  Use this to turn off dimension
	extension lines so that underlying centerlines show.

c:dsa - Dimension Suppress Arrows
	Each pick of a dimension cycles through possible combinations
	of suppressed arrows.

c:dsh - Dimension Stack Horizontal toggle
	Toggles stacked horizontal fractions on/off


c:dino- Dimension INches Only toggle
	Toggles dimensions from inches only to feet and inches

c:dwd - Dimension Width Dynamic
	Select a dimension then use the + and - keys on the numeric
	keypad to dynamically decrease and increase the width factor
	for the dimension text.  This width factor is applied as an
	mtext format in the dimension text override.

Michael Weaver
AlasCAD
1073 Badger Road
North Pole, Alaska 99705
Email: mweaver@bettisworth.com
Email: michael.weaver@acsalaska.net
(c)2001, 2003 Michael Weaver"


)
	 (princ)
	 )


(defun c:dwd(			;Dimension Width Dynamic
	     /
	     ent inkey newOverride newwf objdim objdoc objtstyle oldOverride temp tstyle
	     )
  (defun *error* (msg)
    (cond
      ((or
	 (= msg "quit / exit abort")
	 (= msg "Function cancelled")
	 )
       nil
       )
      (T(princ msg))
      )
    (princ)
    )
  (cond
    ((not (setq ent (entsel)))
     nil			;nothing selected
     )
    ((not (setq			;textOverride property not available
	    ent (car ent)
	    objDim (vlax-ename->vla-object ent)
	    temp (vlax-property-available-p objdim 'TextOverride)
	    )
	  )			;end not
     (princ "\nNot a valid dimension object.")
     )
    (T
     (princ "\nAdjust the dimension text width factor with the + and - keys.\n")
     (setq
       tstyle (vla-get-textstyle objdim)
       objDoc (vla-get-activedocument (vla-get-application objdim))
       objTStyle (vla-item (vla-get-textstyles objdoc) tstyle)
       newwf (vla-get-width objTStyle)
       )
     (while (/= 27 (setq inkey (cadr (grread nil 8))))
       ;;;(princ inkey)
       (cond
	 ((= inkey 45)
	  (setq newwf (* newwf 0.95))
	 )
	 ((= inkey 43)
	  (setq newwf (/ newwf 0.95))
	 )
       )
       (setq
	 oldOverride (vla-get-textOverride objdim)
	 newOverride (cond
		     ((= "" oldOverride)
		      (strcat "\\W" (rtos newwf 2 4) ";<>")
		      )
		     ((= "\\W" (substr oldOverride 1 2))
		      (strcat "\\W" (rtos newwf 2 4)";"
			      (substr oldOverride (+ (vl-string-position (ascii ";") oldOverride) 2))
			      )
		      )
		     (T
		      (strcat "\\W" (rtos newwf 2 4) ";" oldOverride)
		      )
		     )
	 )
       (vla-put-textOverride objdim newOverride)
       (vla-update objdim)
       (princ (strcat "\rCurrent Width Factor = "	;was \015
		      (rtos newwf 2 4)
		      "       "
	      )			;end strcat
       )			;end princ
     )				;end while
     )				;end T
    )				;end cond
  (princ)
  )				;end c:dwd
     
    



(defun c:dino(			;Dimension INches Only toggle
	      /
	      ent objdim *error*
	      )
  (defun *error* (msg)
    (cond
      ((= msg "quit / exit abort")
       nil
       )
      (T(princ msg))
      )
    (princ)
    )
  
  (if (= 1 (getvar "measurement"))
    (dimse:metric-error "Trying to convert metric dimensions to feet and inches?  Sorry, can't do that with this.")
    )
  (and
    (setq ent (entsel))
    (progn
      (setq
	ent (car ent)
	objDim (vlax-ename->vla-object ent)
	)
      (if (vlax-property-available-p objDim 'UnitsFormat)
	(if (= 4 (vla-get-unitsformat objdim))
	  (progn
	    (vla-put-unitsformat objdim 5)
	    (vla-put-textsuffix objdim "\"")
	    )			;end progn unitsformat=4
	  (progn
	    (vla-put-unitsformat objdim 4)
	    (vla-put-textsuffix objdim "")
	    )			;end progn unitsformat<>4
	  )			;end if unitsformat = 4?
	)			;end if property-available
      )				;end progn
    )				;end and
  (princ)
  )				;end c:dino




(defun c:dsh(			;Dim Stack Horizontal
	     / ent objDim *error*
	     )
  (defun *error* (msg)
    (cond
      ((= msg "quit / exit abort")
       nil
       )
      (T(princ msg))
      )
    (princ)
    )

  (if (= 1 (getvar "measurement"))
    (dimse:metric-error "What? You want fractional metric dimensions? Sorry, you're going to have to do that one on your own.")
    )
  (and
    (setq ent (entsel))
    (progn
      (setq
	ent (car ent)
	objDim (vlax-ename->vla-object ent)
	)
      (if (vlax-property-available-p objDim 'FractionFormat)
	(progn
	  (if (= 0 (vla-get-fractionformat objDim))
	    (vla-put-fractionformat objDim 2)
	    (vla-put-fractionformat objDim 0)
	    )
	  )
	)
      )
    )
  (princ)
  )

(defun dimse:metric-error(msg)
  (alert (strcat msg "\nIf this isn't a metric drawing change \"Measurement\" to 0."))
  (vl-exit-with-error  "quit / exit abort") 
)


(defun c:dse(			;Dimension Suppress Extension lines
	     /
	     acadobj dimobj docobj elist ent ext1 ext2 msg test
	     )
  (while
    (cond
      ;;nothing selected
      ((not (setq ent (entsel "\nSelect dimension for extension line suppression: ")))
       nil
       )
      ;;it wasn't a dimension
      ((not (setq
	      elist (entget (car ent))
	      test (= (cdr (assoc 0 elist)) "DIMENSION")
	      )
	    )
       T
       )
      ;it has extension lines
      ((or (logand (setq test (cdr (assoc 70 elist))) 0)
	   (logand test 1)
	   (logand test 2)
	   (logand test 5)
	   )
       T
       )
      (T nil)
      )				;end cond, validate the entity selection
    (setq
      acadobj (vlax-get-acad-object)
      docobj (vla-get-activedocument acadobj)
      dimobj (vlax-ename->vla-object (car ent))
      ext1 (vla-get-ExtLine1Suppress dimobj)
      ext2 (vla-get-ExtLine2Suppress dimobj)
      )
    (cond
      ;;Neither suppressed
      ((and (= :vlax-false ext1)(= :vlax-false ext2))
       (vla-put-ExtLine1Suppress dimobj :vlax-true)
       (setq msg "Suppress extension line 1 but not 2")
       )
      ;;first suppressed
      ((and (= :vlax-true ext1)(= :vlax-false ext2))
       (vla-put-ExtLine1Suppress dimobj :vlax-false)
       (vla-put-ExtLine2Suppress dimobj :vlax-true)
       (setq msg "Suppress extension line 2 but not 1")
       )
      ;;second suppressed
      ((and (= :vlax-false ext1)(= :vlax-true ext2))
       (vla-put-ExtLine1Suppress dimobj :vlax-true)
       (vla-put-ExtLine2Suppress dimobj :vlax-true)
       (setq msg "Suppress both extension lines")       
       )
      ;;both suppressed
      ((and (= :vlax-true ext1)(= :vlax-true ext2))
       (vla-put-ExtLine1Suppress dimobj :vlax-false)
       (vla-put-ExtLine2Suppress dimobj :vlax-false)
       (setq msg "Suppress niether extension line")
       )
      (T nil)
      )				;end cond
    (vla-update dimobj)
    (princ (strcat "\n" msg " "))
    )				;end while

    ;;release the active-x objects
    (foreach obj '(dimobj docobj acadobj)
      (if (and
	    obj
	    (= 'VLA-OBJECT (type obj))
	    (not (vlax-object-released-p obj))
	    )
	(vlax-release-object obj)
	)
      )
    (princ)
  )


(defun c:dsa(			;Dimension Suppress Arrows
	     /
	     arw1 arw1t arw2 arw2t elist ent msg objdim test defartype
	     )
  (setq defartype 4)		;Architectural tick
  (while
    (cond
      ;;nothing selected
      ((not (setq ent (entsel "\nSelect dimension for extension line suppression: ")))
       nil
       )
      ;;it wasn't a dimension
      ((not (setq
	      objDim (vlax-ename->vla-object (car ent))
	      elist (entget (car ent))
	      test (= (cdr (assoc 0 elist)) "DIMENSION")
	      )
	    )
       T
       )
      ;it has arrows/tics
      ((and
	 (vlax-property-available-p objDim 'Arrowhead1Type)
	 (vlax-property-available-p objDim 'Arrowhead2Type)
	 )
       T
       )
      (T nil)
      )				;end cond, validate the entity selection
    (setq
      Arw1 (vla-get-Arrowhead1Type objDim)
      Arw2 (vla-get-Arrowhead2Type objDim)
      Arw1T (if Arw1T Arw1T (if (= 19 Arw1) defartype arw1))
      Arw2T (if Arw2T Arw2T (if (= 19 Arw2) defartype arw2))
      )
    (cond
      ;;Neither suppressed
      ((and (/= 19 Arw1)(/= 19 Arw2))
       (vla-put-Arrowhead1Type objDim 19)
       (setq msg "Suppress arrow 1 but not 2")
       )
      ;;first suppressed
      ((and (= 19 Arw1)(/= 19 Arw2))
       (vla-put-Arrowhead1Type objDim Arw1T)
       (vla-put-Arrowhead2Type objDim 19)
       (setq msg "Suppress arrow 2 but not 1")
       )
      ;;second suppressed
      ((and (/= 19 Arw1)(= 19 Arw2))
       (vla-put-Arrowhead1Type objDim 19)
       (vla-put-Arrowhead2Type objDim 19)
       (setq msg "Suppress both arrows")       
       )
      ;;both suppressed
      ((and (= 19 Arw1)(= 19 Arw2))
       (vla-put-Arrowhead1Type objDim Arw1T)
       (vla-put-Arrowhead2Type objDim Arw2T)
       (setq msg "Suppress niether arrow")
       )
      (T nil)
      )				;end cond
    (vla-update objDim)
    (princ (strcat "\n" msg " "))
    )				;end while
    (princ)
  )

(progn
  (princ "\nDimse.lsp (c)2003 Michael Weaver\n DSE, DSA, DSH, DINO, and DWD.")
  (princ "\nDIMSE for descriptions ")
  (princ)
  )