Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Create hatch- Specific scale (need help!)

Status
Not open for further replies.

SstennizZ

Programmer
Jan 25, 2008
7
NL
For my company I have created a lisp that makes the placement of a custom hatch easy.
In it, the user gets to choose the hatch scale and angle by inserting the specific angle or real.
This works perfect, but I wanted to change the scale part.
I want the user to choose between three different hatchscales:
Fine (0.5), Normal (1) and Double (2)

I tried implementing this in the lisp, but cant get it to work.
Can anybody check the codes and help me out?

The code:
(defun C:HD2 (/ *error*)
(defun *error* (msg)
(cond
((or (not msg)
(member msg
'("console break"
"function cancelled"
"quit / exit abort"
)
)
)
)
((princ (strcat "\nError: " msg)))
)
(cond (osm (setvar "osmode" osm)))
(cond (clyr (setvar "clayer" clyr)))
(cond (ccol (setvar "cecolor" ccol)))
(cond (cpat (setvar "hpname" cpat)))
(cond (hpas (setvar "hpassoc" hpas)))
(cond (hang (setvar "hpang" hang)))
(cond (csca (setvar "hpscale" csca)))
(cond (canno (setvar "cannoscale" canno)))
(command "._-layer" "on" "*" "") ;reactivate all layers
(princ)
)

;; local function, to create layer
(defun layer_set (lyr col ltp)
(setvar "cmdecho" 0)
(if (tblsearch "layer" lyr)
(command "._-layer" "t" lyr "u" lyr "on" lyr "s" lyr "")
(command "._-layer" "m" lyr "c" col lyr "lt" ltp lyr "")
)
)

;; main part
(setvar "cmdecho" 0) ; disable command line echo
(setq osm (getvar "osmode")) ;store osnap settings
(setq clyr (getvar "clayer")) ;store current layer
(setq csca (getvar "hpscale")) ;store current hpscale
(setq ccol (getvar "cecolor")) ; store current layer color
(setq cpat (getvar "hpname")) ; store the hatch pattern
(setq hpas (getvar "hpassoc")) ; store the hatch associativity
(setq hang (getvar "hpang")) ; store the hatch angle
(setq canno (getvar "cannoscale")) ; store cannoscale
(command "._-layer" "off" "*" "y" "on" "0,Arcering,Dakplan,Defpoints,Hekwerk,Tekst" "") ;zet alles layers uit, en vervolgens 0, defpoints,arcering, dakplan, hekwerk en tekst weer aan
(setvar "hpname" "Plat Dak,O") ; set hatch pattern to "Plat Dak"
(setvar "hpassoc" 1) ; set associativity
(layer_set "Arcering" "8" "Bylayer") ;create or set layer "Arcering" current,
;if this would not created before, then create them
; 8 - is color index of this layer, change to you suit
(setvar "osmode" 0)
(setvar "cecolor" "bylayer")
(setvar "cannoscale" "1:100") ;set annotation scale to 1:100. this is necessaity to make sure the hatch pattern "Plat Dak" displays correctly in oterh annotation scales

;TESTCODING
(setq scaleType (getkword "\nGewenste schaal: : "))
(cond
((OR (= scaleType "f") (= scaleType "F")) (setq hatchschaal 0.5) ) ;Fine scale
((OR (=scaleType "n") (= scaleType "N")) (setq hatchschaal 1) ) ;Normal scale
((OR (= scaleType "g") (= scaleType "G")) (setq hatchschaal 2) ) ;Double scale
) ;designate letters
(setq *hatchscale hatchschaal)

(if (null *hatchscale) (setq *hatchscale 1))

(setvar "hpscale" *hatchscale)

;END TESTCODING

;OLD CODING

;define global variable *hatchscale
;(if (null *hatchscale) (setq *hatchscale 1))
;(if *hatchscale
; (setq #B (getreal (strcat "\nVoer arceer schaal in <"(rtos *hatchscale)">: ")))
; )
; (if #B (setq *hatchscale #B) )

; (setvar "hpscale" *hatchscale)

;END OLD CODING

;define global variable *hatchangle
(if (null *hatchangle) (setq *hatchangle 0))
(if *hatchangle
(setq #A (getangle (strcat "\nSpecify hatch angle <"(rtos *hatchangle)">: ")))
)
(if #A (setq *hatchangle #A) )

(setvar "hpang" *hatchangle)

(setq ip (getpoint "\nPick internal point: "))
(while ip ;loop for adding multiple "internal points"
(command "-hatch" ip "AN" "y" "") ; add hatch, set annotative to YES
(setq ip (getpoint "\nPick next internal point, press to quit: "))
) ;while

(*error* nil) ;restore all saved system variables
(princ)
)
(princ "\nStart with hv to draw hatch")
(princ)
 
I see 1 or 2 problems, don't know if this will cure it...

Before the 'getkword' line you need an 'imnitget' statement;

(initget "F N G")

then you only need to test for capital letters but user can input lower case as well.

Near beginning you have a few lines starting with;

(cond (osm (setvar "osmode" osm)))

but should be

(cond osm (setvar "osmode" osm))

-so Lisp will treat them as variables, not functions



 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top