Author Topic: Dimension Style Creation (entmake) - User Arrow Types  (Read 6893 times)

0 Members and 1 Guest are viewing this topic.

Xander

  • Guest
Dimension Style Creation (entmake) - User Arrow Types
« on: January 05, 2011, 02:58:45 AM »
Hey guys,

For the last 2 days, I've been attempting to convert some of my companies 'must have' routines to an OSX version of AutoCAD (unfortunately it doesn't support VisualLISP).

The problem I have, is with the Dimension Style Creation. I cannot get it to set a user arrow of 'GTARR1'.  It simply refuses.

I've tried the following:

The other functions work beautifully....just not the dimension style.

Side note: The nice WARNING comment in the code is to stop other office members from tinkering.  They have a knack of messing with things, and no one understands LISP besides myself...to a degree.

Regards,
Xander

Found the following for 2011:
5 DIMBLK (obsolete, now object ID)
6 DIMBLK1 (obsolete, now object ID)
7 DIMBLK2 (obsolete, now object ID)



Code: [Select]
(SETQ xdimrevision$ "REVISION A (05/01/2011)")

;;;CHANGE DIMENSION STYLE SETTINGS HERE (NOTE: Only supports 3 dimension options)
(SETQ xdimensionstyles$
       '(
(("STYLENAME" "GTDIM35")
 ("TEXTSTYLE" "GT-STANDARD")
 ("SHXFONT" "iso3098b.shx")
 ("TEXTHEIGHT" 3.5)
 ("TEXTCOLOR" 3)
)
(("STYLENAME" "GTDIM30")
 ("TEXTSTYLE" "GT-STANDARD")
 ("SHXFONT" "iso3098b.shx")
 ("TEXTHEIGHT" 3.0)
 ("TEXTCOLOR" 2)
)
(("STYLENAME" "GTDIM25")
 ("TEXTSTYLE" "GT-STANDARD")
 ("SHXFONT" "iso3098b.shx")
 ("TEXTHEIGHT" 2.5)
 ("TEXTCOLOR" 7)
)
)
)

;;;CHANGE DIMENSION LAYER SETTINGS HERE
(SETQ xdimensionlayer$
       '(
("NAME" "S-DIMS")    ;Dimension layer name
("COLOR" 7)    ;Specify a color integer without quotations
("LINETYPE" "CONTINUOUS")    ;NOTE: If the linetype does not exist within the drawing, then CONTINUOUS will be adopted
)
)

(DEFUN c:xgtdim ()
  (xcreatelayer    ;CHECK/CREATE LAYER
    (CADR (ASSOC "NAME" xdimensionlayer$))    ;Pull the first value for the placeholder 'NAME' out of the xdimensionlayer$ array
    (CADR (ASSOC "COLOR" xdimensionlayer$))    ;Pull the first value for the placeholder 'COLOR' out of the xdimensionlayer$ array
    (CADR (ASSOC "LINETYPE" xdimensionlayer$))    ;Pull the first value for the placeholder 'LINETYPE' out of the xdimensionlayer$ array
  )    ;end create layer function

  (SETQ opt$ (GETINT    ;Prompt the user for the type of dimension to use
      "\nEnter dimstyle to load [35]=GT35, [30]=GT30 or [25]=GT25 <35>: "
    )
  )

  (SETQ i$ 0)    ;Set a simple iteration value to manage the xdimensionstyles$ array, by setting it to 0, if no value was enterd in the GETINIT, GT35 will be used
  (IF (= 35 opt$)
    (SETQ i$ 0)
  )    ;If the user prompt result was 35, use the first item in the style array
  (IF (= 30 opt$)
    (SETQ i$ 1)
  )    ;If the user prompt result was 30, use the second item in the style array
  (IF (= 25 opt$)
    (SETQ i$ 2)
  )    ;If the user prompt result was 25, use the second item in the style array

  (xcreatetextstyle    ;CHECK/CREATE TEXT STYLE
    (CADR (ASSOC "TEXTSTYLE" (NTH i$ xdimensionstyles$)))    ;Pull the TEXTSTYLE value from the array (array item specified using the i$ value)
    (CADR (ASSOC "SHXFONT" (NTH i$ xdimensionstyles$)))    ;Pull the SHXFONT value from the array (array item specified using the i$ value)
  )

  (COMMAND "INSERT" "GTARR1" "0,0" ^c)    ;Ensure the Arrow block is referenced within the drawing
  (COMMAND "INSERT" "GTARR7" "0,0" ^c)    ;Ensure the Leader Arrow block is referenced within the drawing

  (xcreatedimensionstyle    ;CHECK/CREATE DIMENSION STYLE
    (CADR (ASSOC "STYLENAME" (NTH i$ xdimensionstyles$)))    ;Pull the STYLENAME value from the array (array item specified using the i$ value)
    (CADR (ASSOC "TEXTSTYLE" (NTH i$ xdimensionstyles$)))    ;Pull the TEXTSTYLE value from the array (array item specified using the i$ value)
    (CADR (ASSOC "TEXTHEIGHT" (NTH i$ xdimensionstyles$)))    ;Pull the TEXTHEIGHT value from the array (array item specified using the i$ value)
    (CADR (ASSOC "TEXTCOLOR" (NTH i$ xdimensionstyles$)))    ;Pull the TEXTCOLOR value from the array (array item specified using the i$ value)
  )

)

;|
**=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=**
**WARNING: TAMPERING WITH ANY OF THE FUNCTIONS BELOW COULD CAUSE A FAULT TO THE LISP ROUTINES, WHICH CAN BE A PAIN TO DEBUG.         **
**         IF YOU WISH TO HAVE A SETTING CHANGED PLEASE CONSIDER THE FOLLOWING FIRST:                                                **
**         -DO YOU HAVE AN UNDERSTANDING OF LISP ROUTINES AND HOW TO CHANGE THEM?                                                    **
**         -DO YOU KNOW WHERE YOUR ISSUES LIES AND WHAT THE EXACT PROBLEM IS?                                                        **
**=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=**
|;

;;;CREATE LAYER FROM SCRATCH
(DEFUN xcreatelayer (xname$ xcolor$ xltype$ / res$)
  (IF (= nil (TBLSEARCH "LTYPE" xltype$))    ;If the LineType table has the LineType specified
    (PROGN    ;CASE TRUE, do the following
      (PRINC (STRCAT "\nLinetype: '"    ;Inform the user that the specified linetype couldn't be found
    xltype$
    "' could NOT be found, adopting CONTINUOUS."
    )
      )
      (SETQ xltype$ "CONTINUOUS")    ;Set xltype$ to CONTINUOUS
    )    ;End of case true
  )    ;End of if
  (IF (= nil (TBLSEARCH "LAYER" xname$))    ;If the result of the table search is nil, i.e no layer exists
    (PROGN    ;CASE TRUE, Do the following
      (SETQ res$ (LIST    ;Create a list of the layer properties
  (CONS 0 "LAYER")    ;Entity Type
  (CONS 100 "AcDbSymbolTableRecord")    ;Subclass Marker
  (CONS 100 "AcDbLayerTableRecord")    ;Subclass Marker
  (CONS 2 xname$)    ;Layer Name
  (CONS 6 xltype$)    ;Layer Linetype
  (CONS 62 xcolor$)    ;Layer Color
  (CONS 70 0)    ;Standard Flag Values
  (CONS 290 1)    ;Plotable Layer, 1=Plot, 0=Non-Plot
)
      )
      (ENTMAKE res$)    ;Make the entity
      (PRINC    ;Provide the user with feedback, NOTE: STRCAT allows string addition
(STRCAT "\nSucessfully created the layer: '"
xname$
"' into the current drawing."
)
      )    ;Provide user feedback
    )    ;End of case true
    (PROGN    ;CASE FALSE, Do the following
      (PRINC    ;provide user feedback
(STRCAT "\nLayer: '"
xname$
"' already exists within the current drawing."
)
      )
    )    ;End of case false
  )    ;End of if
)

;;;CREATE TEXT STYLE FROM SCRATCH
;;;DXF CODE VALUES BASED ON GT-STANDARD FONT STYLE
(DEFUN xcreatetextstyle (xname$ xfont$ / res$)
  (IF (= nil (TBLSEARCH "STYLE" xname$))    ;If the text style table does not have the text style
    (PROGN    ;CASE TRUE, do the following
      (SETQ res$    ;Create a list of the style properties
    (LIST
      (CONS 0 "STYLE")    ;Entity type
      (CONS 100 "AcDbSymbolTableRecord")    ;Subclass marker
      (CONS 100 "AcDbTextStyleTableRecord")    ;Subclass marker
      (CONS 2 xname$)    ;Style Name
      (CONS 70 0)    ;Standard flag value
      (CONS 40 0)    ;Fix text height; 0 if not fixed
      (CONS 41 0.75)    ;Text width factor
      (CONS 50 0)    ;Text oblique angle
      (CONS 71 0)    ;Text generation flags, 0-none, 2-backwards, 4-upsidedown
      (CONS 42 0)    ;Use last text height
      (CONS 3 xfont$)    ;Primary font file name (shx)
      (CONS 4 "")    ;Bigfont file name; blank if none
    )
      )
      (ENTMAKE res$)    ;Make the entity
      (PRINC    ;Report the sucessfull creation of the entity back to the user
(STRCAT
 "\nSucessfully created the text style: '"
 xname$
 "' within the current drawing."
)
      )
    )    ;End case true
    (PROGN    ;CASE FALSE, do the following
      (PRINC    ;Report the issue to the user
(STRCAT
 "\nText Style: '"
 xname$
 "' already exists within the current drawing."
)
      )    ;
    )    ;End case false
  )    ;End if
)

;;;CREATE DIMENSION STYLE FROM SCRATCH
;;;DXF CODE VALUES BASED ON GT35 DIMENSION STYLE
(DEFUN xcreatedimensionstyle (xname$ xstyle$ xheight$ xcolor$ / res$ olddimldrblk$ olddimblk$)
  (IF (= nil (TBLSEARCH "DIMSTYLE" xname$))    ;If the text style table does not have the text style
    (PROGN    ;CASE TRUE, do the following
      (SETQ res$
    (LIST
      (CONS 0 "DIMSTYLE")    ;Entity Type
      (CONS 100 "AcDbSymbolTableRecord")    ;Subclass marker
      (CONS 100 "AcDbDimStyleTableRecord")    ;Subclass marker
      (CONS 2 xname$)    ;Dimstyle name
      (CONS 70 0)    ;Standard flag value
      (CONS 3 "")    ;DIMPOST   - Prefix and suffix for dimension text
      (CONS 4 "")    ;DIMAPOST  - Prefix and suffix for alternate text
      (CONS 5 "GTARR1")    ;DIMBLK    - Arrow block name
      (CONS 6 "GTARR1")    ;DIMBLK1   - First arrow block name
      (CONS 7 "")    ;DIMBLK2   - Second arrow block name
      (CONS 40 100.0)    ;DIMSCALE  - Overall Scale Factor
      (CONS 41 1.0)    ;DIMASZ    - Arrow size
      (CONS 42 2.0)    ;DIMEXO    - Extension line origin offset
      (CONS 43 0.0)    ;DIMDLI    - Dimension line spacing
      (CONS 44 2.0)    ;DIMEXE    - Extension above dimension line
      (CONS 45 0.0)    ;DIMRND    - Rounding value
      (CONS 46 0.0)    ;DIMDLE    - Dimension line extension
      (CONS 47 0.0)    ;DIMTP     - Plus tolerance
      (CONS 48 0.0)    ;DIMTM     - Minus tolerance
      (CONS 140 xheight$)    ;DIMTXT    - Text height
      (CONS 141 0.09)    ;DIMCEN    - Centre mark size
      (CONS 142 0.0)    ;DIMTSZ    - Tick size
      (CONS 143 25.4)    ;DIMALTF   - Alternate unit scale factor
      (CONS 144 1.0)    ;DIMLFAC   - Linear unit scale factor
      (CONS 145 0.0)    ;DIMTVP    - Text vertical position
      (CONS 146 1.0)    ;DIMTFAC   - Tolerance text height scaling factor
      (CONS 147 1.0)    ;DIMGAP    - Gape from dimension line to text
      (CONS 71 0)    ;DIMTOL    - Tolerance dimensioning
      (CONS 72 0)    ;DIMLIM    - Generate dimension limits
      (CONS 73 0)    ;DIMTIH    - Text inside extensions is horizontal
      (CONS 74 0)    ;DIMTOH    - Text outside horizontal
      (CONS 75 0)    ;DIMSE1    - Suppress the first extension line
      (CONS 76 0)    ;DIMSE2    - Suppress the second extension line
      (CONS 77 1)    ;DIMTAD    - Place text above the dimension line
      (CONS 78 0)    ;DIMZIN    - Zero suppression
      (CONS 170 0)    ;DIMALT    - Alternate units selected
      (CONS 171 2)    ;DIMALTD   - Alternate unit decimal places
      (CONS 172 0)    ;DIMTOFL   - Force line inside extension lines
      (CONS 173 0)    ;DIMSAH    - Separate arrow blocks
      (CONS 174 0)    ;DIMTIX    - Place text inside extensions
      (CONS 175 0)    ;DIMSOXD   - Suppress outside dimension lines
      (CONS 176 1)    ;DIMCLRD   - Dimension line and leader color
      (CONS 177 1)    ;DIMCLRE   - Extension line color
      (CONS 178 xcolor$)    ;DIMCRRT   - Dimension text color
      (CONS 270 2)
      (CONS 271 0)    ;DIMADEC   - Angular decimal places
      (CONS 272 0)    ;DIMTDEC   - Tolerance decimal places
      (CONS 273 2)    ;DIMALTU   - Alternate units
      (CONS 274 2)    ;DIMALTTD  - Alternate tolerance decimal places
      (CONS 275 0)    ;DIMAUNIT  - Angular unit format
      (CONS 280 0)    ;DIMJUST   - Justification of text on dimension line
      (CONS 281 0)    ;DIMSD1    - Suppress the first dimension line
      (CONS 282 0)    ;DIMSD2    - Suppress the second dimensions line
      (CONS 283 1)    ;DIMTOLJ   - Tolerance vertical justification
      (CONS 284 0)    ;DIMTZIN   - Zero suppression
      (CONS 285 0)    ;DIMALTZ   - Alternate unit zero suppression
      (CONS 286 0)    ;DIMALTTZ  - Alternate tolerance zero suppression
      (CONS 287 5)
      (CONS 288 1)    ;DIMUPT    - User positioned text
      (CONS 340 (TBLOBJNAME "STYLE" xstyle$))    ;DIMTXSTY  - Text style
    )    ;End of list
      )    ;End of setq
      (ENTMAKE res$)    ;Make the entity
      (PRINC    ;Report the sucessfull creation of the entity back to the user
(STRCAT
 "\nSucessfully created the dimension style: '"
 xname$
 "' within the current drawing."
)
      )
    )    ;End of case true
    (PROGN    ;CASE FALSE, do the following
      (PRINC    ;Report the issue to the user
(STRCAT
 "\nDimension style: '"
 xname$
 "' already exists within the current drawing."
)
      )
    )    ;End of case false
  )
)

;;;**=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=**
;;;Allows for clean loading of utilities and informs the user of the current LISP version on load.
(PRINC
  (STRCAT "\nX_DIMENSION_UTILITIES.LSP "
 xdimrevision$
 " sucessfully loaded..."
  )
)
Just had a thought, would the DXF codes 342, 343 and 344 work. Just noticed them in the 2011 DXF list here:
http://images.autodesk.com/adsk/files/acad_dxf2.pdf
« Last Edit: January 05, 2011, 05:51:29 PM by Xander »

Joe Burke

  • Guest
Re: Dimension Style Creation (entmod) - User Arrow Types
« Reply #1 on: January 05, 2011, 07:42:55 AM »
I assume by "OSX version" you mean AutoCAD running on a Mac?

Xander

  • Guest
Re: Dimension Style Creation (entmod) - User Arrow Types
« Reply #2 on: January 05, 2011, 05:04:47 PM »
I assume by "OSX version" you mean AutoCAD running on a Mac?
Correct.

This is an updated xcreatedimensionstyle function, which uses the custom arrows.  Just make sure the block-reference actually exists in the drawing.

Code: [Select]
(DEFUN xcreatedimensionstyle (xname$ xstyle$ xheight$ xcolor$ / res$ olddimldrblk$ olddimblk$)
  (IF (= nil (TBLSEARCH "DIMSTYLE" xname$))    ;If the text style table does not have the text style
    (PROGN    ;CASE TRUE, do the following
      (SETQ res$
    (LIST
      (CONS 0 "DIMSTYLE")    ;Entity Type
      (CONS 100 "AcDbSymbolTableRecord")    ;Subclass marker
      (CONS 100 "AcDbDimStyleTableRecord")    ;Subclass marker
      (CONS 2 xname$)    ;Dimstyle name
      (CONS 70 0)    ;Standard flag value
      (CONS 3 "")    ;DIMPOST   - Prefix and suffix for dimension text
      (CONS 4 "")    ;DIMAPOST  - Prefix and suffix for alternate text
      ;;(CONS 5 "GTARR1")   -DXF CODES OBSOLETE    ;DIMBLK    - Arrow block name
      ;;(CONS 6 "GTARR1")   -DXF CODES OBSOLETE    ;DIMBLK1   - First arrow block name
      ;;(CONS 7 "")         -DXF CODES OBSOLETE    ;DIMBLK2   - Second arrow block name
      (CONS 40 100.0)    ;DIMSCALE  - Overall Scale Factor
      (CONS 41 1.0)    ;DIMASZ    - Arrow size
      (CONS 42 2.0)    ;DIMEXO    - Extension line origin offset
      (CONS 43 0.0)    ;DIMDLI    - Dimension line spacing
      (CONS 44 2.0)    ;DIMEXE    - Extension above dimension line
      (CONS 45 0.0)    ;DIMRND    - Rounding value
      (CONS 46 0.0)    ;DIMDLE    - Dimension line extension
      (CONS 47 0.0)    ;DIMTP     - Plus tolerance
      (CONS 48 0.0)    ;DIMTM     - Minus tolerance
      (CONS 140 xheight$)    ;DIMTXT    - Text height
      (CONS 141 0.09)    ;DIMCEN    - Centre mark size
      (CONS 142 0.0)    ;DIMTSZ    - Tick size
      (CONS 143 25.4)    ;DIMALTF   - Alternate unit scale factor
      (CONS 144 1.0)    ;DIMLFAC   - Linear unit scale factor
      (CONS 145 0.0)    ;DIMTVP    - Text vertical position
      (CONS 146 1.0)    ;DIMTFAC   - Tolerance text height scaling factor
      (CONS 147 1.0)    ;DIMGAP    - Gape from dimension line to text
      (CONS 71 0)    ;DIMTOL    - Tolerance dimensioning
      (CONS 72 0)    ;DIMLIM    - Generate dimension limits
      (CONS 73 0)    ;DIMTIH    - Text inside extensions is horizontal
      (CONS 74 0)    ;DIMTOH    - Text outside horizontal
      (CONS 75 0)    ;DIMSE1    - Suppress the first extension line
      (CONS 76 0)    ;DIMSE2    - Suppress the second extension line
      (CONS 77 1)    ;DIMTAD    - Place text above the dimension line
      (CONS 78 0)    ;DIMZIN    - Zero suppression
      (CONS 170 0)    ;DIMALT    - Alternate units selected
      (CONS 171 2)    ;DIMALTD   - Alternate unit decimal places
      (CONS 172 0)    ;DIMTOFL   - Force line inside extension lines
      (CONS 173 0)    ;DIMSAH    - Separate arrow blocks
      (CONS 174 0)    ;DIMTIX    - Place text inside extensions
      (CONS 175 0)    ;DIMSOXD   - Suppress outside dimension lines
      (CONS 176 1)    ;DIMCLRD   - Dimension line and leader color
      (CONS 177 1)    ;DIMCLRE   - Extension line color
      (CONS 178 xcolor$)    ;DIMCRRT   - Dimension text color
      (CONS 270 2)    ;DIMUNIT (Obsolete in 2011, DIMLUNIT and DIMFRAC)
      (CONS 271 0)    ;DIMADEC   - Angular decimal places
      (CONS 272 0)    ;DIMTDEC   - Tolerance decimal places
      (CONS 273 2)    ;DIMALTU   - Alternate units
      (CONS 274 2)    ;DIMALTTD  - Alternate tolerance decimal places
      (CONS 275 0)    ;DIMAUNIT  - Angular unit format
      (CONS 280 0)    ;DIMJUST   - Justification of text on dimension line
      (CONS 281 0)    ;DIMSD1    - Suppress the first dimension line
      (CONS 282 0)    ;DIMSD2    - Suppress the second dimensions line
      (CONS 283 1)    ;DIMTOLJ   - Tolerance vertical justification
      (CONS 284 0)    ;DIMTZIN   - Zero suppression
      (CONS 285 0)    ;DIMALTZ   - Alternate unit zero suppression
      (CONS 286 0)    ;DIMALTTZ  - Alternate tolerance zero suppression
      (CONS 287 5)    ;DIMFIT (Obsolete in 2011, DIMATFIT and DIMTMOVE)
      (CONS 288 1)    ;DIMUPT    - User positioned text
      (CONS 340 (TBLOBJNAME "STYLE" xstyle$))    ;DIMTXSTY  - Text style
      (CONS 341
    (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" "GTARR7"))))
      )    ;DIMLDRBLK - Leader arrow block name
      (CONS 342
    (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" "GTARR1"))))
      )    ;DIMBLK    - Arrow block name
      (CONS 343
    (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" "GTARR1"))))
      )    ;DIMBLK1   - First arrow block name
      (CONS 344
    (CDR (ASSOC 330 (ENTGET (TBLOBJNAME "BLOCK" "GTARR1"))))
      )    ;DIMBLK2   - Second arrow block name
    )    ;End of list
      )    ;End of setq
      (ENTMAKE res$)    ;Make the entity
      (PRINC    ;Report the sucessfull creation of the entity back to the user
(STRCAT
 "\nSucessfully created the dimension style: '"
 xname$
 "' within the current drawing."
)
      )
    )    ;End of case true
    (PROGN    ;CASE FALSE, do the following
      (PRINC    ;Report the issue to the user
(STRCAT
 "\nDimension style: '"
 xname$
 "' already exists within the current drawing."
)
      )
    )    ;End of case false
  )
)
« Last Edit: January 05, 2011, 07:19:04 PM by Xander »