zwcad 사용하고 계시는분이요…auto리습잘쓴던게 안되네요…
컨텐츠 정보
- 309 조회
- 4 댓글
- 0 추천
- 0 비추천
- 목록
본문
zw캐드를 사용하면서 너무 불편한게 많아서 도움 요청드립니다.
auto캐드와는 거의 흡사하고 편리성도 갖췄지만….흔하게 썼던 리습들이 구동을 안하네요…
경로나…로드 다~시켜봐도 되질 않습니다.
주로 사용하는 리습은
qa-이건 면적 따는 리습인거 아시죠? 요건 잘 작동 합니다.
cht-문자수정 리습입니다. 문자 속성을 다 바꿀수 있어서 유용하게 썼지만…지금은 폭망인 상태입니다.
g- 이건 객체들 속성 수정 리습입니다. 선을 선택하면 레이어와 색상 등 간단한 속성을 수정해주는 리습인데…이것도 zw캐드에서는 안되네요….ㅠㅠ
cht,g 이거 두개만 되어도 쉽게쉽게 가능할꺼 같은데….혹시 해결방법이 있는지좀 알고 싶습니다.
도와주세요~ㅜ
이건 cht 문구수정 리습입니다.
; Next available MSG number is 83
; MODULE_ID CHTEXT_LSP_
;;;
;;; CHTEXT.lsp – change text
;;;
;;; Copyright 1997 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software – Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;————————————————————————–;
;;; DESCRIPTION
;;; This is a "text processor" which operates in a global manner
;;; on all of the text entities that the user selects; i.e., the
;;; Height, Justification, Location, Rotation, Style, Text, and
;;; Width can all be changed globally or individually, and the
;;; range of values for a given parameter can be listed.
;;;
;;; The command is called with CHT from the command line at which
;;; time the user is asked to select the objects to change.
;;;
;;; Select text to change.
;;; Select objects:
;;;
;;; If nothing is selected the message "ERROR: Nothing selected."
;;; is displayed and the command is terminated. If more than 25
;;; entities are selected the following message is displayed while
;;; the text entities are sorted out from the non-text entities.
;;; A count of the text entities found is then displayed.
;;;
;;; Verifying the selected entities…
;;; nnn text entities found.
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;;
;;; A typical example of the prompts you may encounter follows:
;;;
;;; If you select a single text entity to change and ask to change
;;; the height, the prompt looks like this:
;;;
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;; New text height for text entity. <0.08750000>:
;;;
;;; If you select more than one text entity to change and ask to change
;;; the height, the prompt looks like this:
;;;
;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width:
;;; Individual/List/:
;;;
;;; Typing "L" at this prompt returns a prompt showing you the range of
;;; values that you are using for your text.
;;;
;;; Height — Min: 0.05000000 Max: 0.10000000 Ave: 0.08392857
;;;
;;; Typing "I" at this prompt puts you in a loop, processing the text
;;; entities you have selected one at a time, and giving the same prompt
;;; you get for a single text entity shown above.
;;;
;;; Pressing ENTER at this point puts you back at the Command: prompt.
;;; Selecting any of the other options allows you to change the text
;;; entities selected.
;;;
;;;—————————————————————————;
(defun cht_Main ( / sset opt ssl nsset temp unctr ct_ver sslen style hgt rot
txt ent loc loc1 just-idx justp justq orthom
cht_ErrorHandler cht_OrgError cht_OrgCmdecho
cht_OrgTexteval cht_OrgHighlight)
;; Reset if changed
(setq ct_ver "2.00″)
;; Internal error handler defined locally
(defun cht_ErrorHandler (s)
(if (/= s "Function cancelled")
(if (= s "quit / exit abort")
(princ)
(princ (strcat "nError: " s))
)
)
(eval (read U:E))
;; Reset original error handler if there
(if cht_OrgError (setq *error* cht_OrgError))
(if temp (redraw temp 1))
(ai_undo_off) ;; restore undo state
(if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))
(if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))
(if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))
(princ)
)
;; Set error handler
(if *error*
(setq cht_OrgError *error*
*error* cht_ErrorHandler)
(setq *error* cht_ErrorHandler)
)
;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))
(setq U:G "(command "_.undo" "_group")"
U:E "(command "_.undo" "_en")"
)
(ai_undo_on) ;; enable undo
(setq cht_OrgCmdecho (getvar "cmdecho"))
(setq cht_OrgHighlight (getvar "highlight"))
(setvar "cmdecho" 0)
(princ (strcat "nChange text, Version "
ct_ver
", Copyright ?1997 by Autodesk, Inc."))
(prompt "nSelect annotation objects to change.")
(setq sset (ai_aselect))
(if (null sset)
(progn
(princ "nNo objects selected.")
(exit)
)
)
;; Validate selection set
(setq ssl (sslength sset)
nsset (ssadd))
(if (> ssl 25)
(princ "nVerifying selected objects…")
)
(while (> ssl 0)
(setq temp (ssname sset (setq ssl (1- ssl))))
(if (or
(= (cdr (assoc 0 (entget temp))) "TEXT")
(= (cdr (assoc 0 (entget temp))) "ATTDEF")
(= (cdr (assoc 0 (entget temp))) "MTEXT")
)
(ssadd temp nsset)
)
)
(setq ssl (sslength nsset)
sset nsset
unctr 0
)
(print ssl)
(princ "annotation objects found.")
;; Main loop
(setq opt T)
(while (and opt (> ssl 0))
(setq unctr (1+ unctr))
(command "_.UNDO" "_GROUP")
(initget "Location Justification Style Height Rotation Width Text Undo")
(setq opt (getkword
"nHeight/Justification/Location/Rotation/Style/Text/Undo/Width: "))
(if opt
(cond
((= opt "Undo")
(cht_Undo)
)
((= opt "Location")
(cht_Location)
)
((= opt "Justification")
(cht_Justification)
)
((= opt "Style")
(cht_Property "Style" "New style name" 7) )
((= opt "Height")
(cht_Property "Height" "New height" 40) )
((= opt "Rotation")
(cht_Property "Rotation" "New rotation angle" 50) )
((= opt "Width")
(cht_Property "Width" "New width factor" 41) )
((= opt "Text")
(cht_Text)
)
)
(setq opt nil)
)
(command "_.UNDO" "_END")
)
;; Restore
(if cht_OrgError (setq *error* cht_OrgError))
(eval (read U:E))
(ai_undo_off) ;; restore undo state
(if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))
(if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))
(if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))
(princ)
)
;;; Undo an entry
(defun cht_Undo ()
(if (> unctr 1)
(progn
(command "_.UNDO" "_END")
(command "_.UNDO" "2″)
(setq unctr (- unctr 2))
)
(progn
(princ "nNothing to undo. ")
(setq unctr (- unctr 1))
)
)
)
;;; Change the location of an entry
(defun cht_Location ()
(setq sslen (sslength sset)
style ""
hgt ""
rot ""
txt ""
)
(command "_.CHANGE" sset "" "")
(while (> sslen 0)
(setq ent (entget(ssname sset (setq sslen (1- sslen))))
opt (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
)
(prompt "nNew text location: ")
(command pause)
(if (null loc)
(setq loc opt)
)
(command style hgt rot txt)
)
(command)
)
;;; Change the justification of an entry
(defun cht_Justification ()
(initget "TL TC TR ML MC MR BL BC BR Align Center Fit Left Middle Right ?")
(setq sslen (sslength sset))
(setq justp (getkword "nAlign/Fit/Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR/<?>: "))
(cond
((= justp "Left") (setq justp 0 justq 0 just-idx 4) )
((= justp "Center") (setq justp 1 justq 0 just-idx 5) )
((= justp "Right") (setq justp 2 justq 0 just-idx 6) )
((= justp "Align") (setq justp 3 justq 0 just-idx 1) )
((= justp "Fit") (setq justp 5 justq 0 just-idx 1) )
((= justp "TL") (setq justp 0 justq 3 just-idx 1) )
((= justp "TC") (setq justp 1 justq 3 just-idx 2) )
((= justp "TR") (setq justp 2 justq 3 just-idx 3) )
((= justp "ML") (setq justp 0 justq 2 just-idx 4) )
((= justp "Middle") (setq justp 4 justq 0 just-idx 5) )
((= justp "MC") (setq justp 1 justq 2 just-idx 5) )
((= justp "MR") (setq justp 2 justq 2 just-idx 6) )
((= justp "BL") (setq justp 0 justq 1 just-idx 7) )
((= justp "BC") (setq justp 1 justq 1 just-idx 8) )
((= justp "BR") (setq justp 2 justq 1 just-idx 9) )
((= justp "?") (setq justp nil) )
(T (setq justp nil) )
)
(if justp
(progn ;; Process them…
(while (> sslen 0)
(setq ent (entget (ssname sset (setq sslen (1- sslen)))))
(cond
((= (cdr (assoc 0 ent)) "MTEXT")
(setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent))
)
((= (cdr (assoc 0 ent)) "TEXT")
(setq ent (subst (cons 72 justp) (assoc 72 ent) ent)
opt (trans (list (cadr (assoc 11 ent))
(caddr (assoc 11 ent))
(cadddr (assoc 11 ent)))
(cdr (assoc -1 ent)) ;; from ECS
1) ;; to current UCS
)
(setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
(cond
((or (= justp 3) (= justp 5))
(prompt "nNew text alignment points: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(redraw (cdr (assoc -1 ent)) 3)
(initget 1)
(setq loc (getpoint))
(initget 1)
(setq loc1 (getpoint loc))
(redraw (cdr (assoc -1 ent)) 1)
(setvar "orthomode" orthom)
(setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
(setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
)
((or (/= justp 0) (/= justq 0))
(redraw (cdr (assoc -1 ent)) 3)
(prompt "nNew text location: ")
(if (= (setq orthom (getvar "orthomode")) 1)
(setvar "orthomode" 0)
)
(setq loc (getpoint opt))
(setvar "orthomode" orthom)
(redraw (cdr (assoc -1 ent)) 1)
(if (null loc)
(setq loc opt)
(setq loc (trans loc 1 (cdr (assoc -1 ent))))
)
(setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
)
)
)
)
(entmod ent)
)
)
(progn ;; otherwise list options
(textpage)
(princ "nAlignment options:n")
(princ "t TL TC TRn")
(princ "t ML MC MRn")
(princ "t BL BC BRn")
(princ "t Left Center Rightn")
(princ "tAlign Middle Fitn")
(princ "nPress ENTER to continue: ")
(grread)
(princ "r ")
(graphscr)
)
)
(command)
)
;;; Change the text of an object
(defun cht_Text ( / ans)
(setq sslen (sslength sset))
(initget "Globally Individually Retype")
(setq ans (getkword
"nFind and replace text. Individually/Retype/:"))
(setq cht_OrgTexteval (getvar "texteval"))
(setvar "texteval" 1)
(cond
((= ans "Individually")
(progn
(initget "Yes No")
(setq ans (getkword "nEdit text in dialog? :"))
)
(while (> sslen 0)
(redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
(setq ss (ssadd))
(ssadd (ssname sset sslen) ss)
(if (= ans "No")
(cht_Edit ss)
(command "_.DDEDIT" sn "")
)
(redraw sn 1)
)
)
((= ans "Retype")
(while (> sslen 0)
(setq ent (entget (ssname sset (setq sslen (1- sslen)))))
(redraw (cdr (assoc -1 ent)) 3)
(prompt (strcat "nOld text: " (cdr (assoc 1 ent))))
(setq nt (getstring T "nNew text: "))
(redraw (cdr (assoc -1 ent)) 1)
(if (> (strlen nt) 0)
(entmod (subst (cons 1 nt) (assoc 1 ent) ent))
)
)
)
(T
(cht_Edit sset) ;; Change all
)
)
(setvar "texteval" cht_OrgTexteval)
)
;;; The old CHGTEXT command – rudimentary text editor
(defun C:CHGTEXT () (cht_Edit nil))
(defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp
n_slen o_slen si chf chm cont ans class)
;; Select objects if running standalone
(if (null objs)
(setq objs (ssget))
)
(setq chm 0)
(if objs
(progn ;; If any objects selected
(if (= (type objs) 'ENAME)
(progn
(setq ent (entget objs))
(princ (strcat "nExisting string: " (cdr (assoc 1 ent))))
)
(if (= (sslength objs) 1)
(progn
(setq ent (entget (ssname objs 0)))
(princ (strcat "nExisting string: " (cdr (assoc 1 ent))))
)
)
)
(setq o_str (getstring "nMatch string : " t))
(setq o_slen (strlen o_str))
(if (/= o_slen 0)
(progn
(setq n_str (getstring "nNew string : " t))
(setq n_slen (strlen n_str))
(setq last_o 0
tot_o (if (= (type objs) 'ENAME)
1
(sslength objs)
)
)
;; For each selected object…
(while (< last_o tot_o)
(setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
(if (or (= "TEXT" class)
(= "MTEXT" class) )
(progn
(setq chf nil si 1)
(setq s_temp (cdr (assoc 1 ent)))
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
(if (= st o_str)
(progn
(setq s_temp (strcat
(if (> si 1)
(substr s_temp 1 (1- si))
""
)
n_str
(substr s_temp (+ si o_slen))
)
)
(setq chf t) ;; Found old string
(setq si (+ si n_slen))
)
(setq si (1+ si))
)
)
(if chf
(progn ;; Substitute new string for old
;; Modify the TEXT entity
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
(setq chm (1+ chm))
)
)
)
)
(setq last_o (1+ last_o))
)
)
;; else go on to the next line…
)
)
)
(if (/= (type objs) 'ENAME)
;; Print total lines changed
(if (/= (sslength objs) 1)
(princ (strcat (rtos chm 2 0) " text lines changed."))
)
)
(terpri)
)
;;; Main procedure for manipulating text entities
(defun cht_Property (typ prmpt fld / temp ow nw ent tw sty w hw lw
sslen n sn ssl)
(if (= (sslength sset) 1) ;; Special case if there is only
;; one entity selected
;; Process one entity.
(cht_ProcessOne)
;; Else
(progn
;; Set prompt string.
(cht_SetPrompt)
(if (= nw "List")
;; Process List request.
(cht_ProcessList)
(if (= nw "Individual")
;; Process Individual request.
(cht_ProcessIndividual)
(if (= nw "Select")
;; Process Select request.
(cht_ProcessSelect)
;; Else
(progn
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= (type nw) 'STR)
(if (not (tblsearch "style" nw))
(progn
(princ (strcat nw ": Style not found. "))
)
(cht_ProcessAll)
)
(cht_ProcessAll)
)
)
)
)
)
)
)
)
;;; Change all of the entities in the selection set
(defun cht_ProcessAll (/ hl temp)
(setq sslen (sslength sset))
(setq hl (getvar "highlight"))
(setvar "highlight" 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent ) )
)
(setvar "highlight" hl)
)
;;; Change one text entity
(defun cht_ProcessOne ()
(setq temp (ssname sset 0))
(setq ow (cdr (assoc fld (entget temp))))
(if (= opt "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(redraw (cdr (assoc -1 (entget temp))) 3)
(initget 0)
(if (= opt "Style")
(setq nw (getstring (strcat prmpt " <" ow ">: ")))
(setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: ")))
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(redraw (cdr (assoc -1 (entget temp))) 1)
(if (= opt "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(if (= opt "Style")
(if (null (tblsearch "style" nw))
(princ (strcat nw ": Style not found. "))
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
)
)
;;; Set the prompt string
(defun cht_SetPrompt ()
(if (= typ "Style")
(progn
(initget "Individual List New Select ")
(setq nw (getkword (strcat "nIndividual/List/Select style/<"
prmpt
" for all text objects" ">: ")))
(if (or (= nw "") (= nw nil) (= nw "Enter"))
(setq nw (getstring (strcat prmpt
" for all text objects" ": ")))
)
)
(progn
(initget "List Individual" 1)
(setq nw (getreal (strcat "nIndividual/List/<"
prmpt
" for all text objects" ">: ")))
)
)
)
;;; Process List request
(defun cht_ProcessList ()
(setq unctr (1- unctr))
(setq sslen (sslength sset))
(setq tw 0)
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(if (= typ "Style")
(progn
(if (= tw 0)
(setq tw (list (cdr (assoc fld (entget temp)))))
(progn
(setq sty (cdr (assoc fld (entget temp))))
(if (not (member sty tw))
(setq tw (append tw (list sty)))
)
)
)
)
(progn
(setq tw (+ tw (setq w (cdr (assoc fld (entget temp))))))
(if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
(if (< hw w) (setq hw w))
(if (> lw w) (setq lw w))
)
)
)
(if (= typ "Rotation")
(setq tw (* (/ tw pi) 180.0)
lw (* (/ lw pi) 180.0)
hw (* (/ hw pi) 180.0))
)
(if (= typ "Style")
(progn
(princ (strcat "n" typ "(s) — "))
(princ tw)
)
(princ (strcat "n" typ
" — Min: " (rtos lw 2)
"t Max: " (rtos hw 2)
"t Avg: " (rtos (/ tw (sslength sset)) 2) ) )
)
)
;;; Process Individual request
(defun cht_ProcessIndividual ()
(setq sslen (sslength sset))
(while (> sslen 0)
(setq temp (ssname sset (setq sslen (1- sslen))))
(setq ow (cdr (assoc fld (entget temp))))
(if (= typ "Rotation")
(setq ow (/ (* ow 180.0) pi))
)
(initget 0)
(redraw (cdr (assoc -1 (entget temp))) 3)
(if (= typ "Style")
(progn
(setq nw (getstring (strcat "n" prmpt " <" ow ">: ")))
)
(progn
(setq nw (getreal (strcat "n" prmpt " <" (rtos ow 2) ">: ")))
)
)
(if (or (= nw "") (= nw nil))
(setq nw ow)
)
(if (= typ "Rotation")
(setq nw (* (/ nw 180.0) pi))
)
(entmod (subst (cons fld nw)
(assoc fld (setq ent (entget temp)))
ent
)
)
(redraw (cdr (assoc -1 (entget temp))) 1)
)
)
;;; Process the Select option
(defun cht_ProcessSelect ()
(princ "nSearch for which Style name? <*>: ")
(setq sn (xstrcase (getstring))
n -1
nsset (ssadd)
ssl (1- (sslength sset))
)
(if (or (= sn "*") (null sn) (= sn ""))
(setq nsset sset sn "*")
(while (and sn (< n ssl))
(setq temp (ssname sset (setq n (1+ n))))
(if (= (cdr (assoc 7 (entget temp))) sn)
(ssadd temp nsset)
)
)
)
(princ (strcat "nStyle: " sn))
(print (setq ssl (sslength nsset)))
(princ "objects found.")
)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it. If it can't be found or can't be
;;; loaded, then abort the loading of this file immediately.
(cond
((and ai_dcl (listp ai_dcl))) ; it's already loaded.
((not (findfile "ai_utils.lsp")) ; find it
(ai_abort "CHT" nil)
)
((eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "CHT" nil)
)
)
;;; If we get this far, then AI_UTILS.LSP is loaded and it can
;;; be assumed that all functions defined therein are available.
;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort
;;; if the file can't be found or xloaded. Note that AI_ACADAPP
;;; does not abort the running application itself (so that it can
;;; also be called from within the command without also stopping
;;; an AutoCAD command currently in progress).
(if (not (ai_acadapp)) (ai_abort "CHT" nil))
;;; The C: function definition
(defun c:cht () (cht_Main))
(princ "ntCHT command loaded.")
(princ)
이건 객체수정 g 리습입니다.
; Next available MSG number is 41
; MODULE_ID G_LSP_
;;;—————————————————————————-
;;;
;;; GG.LSP Version 0.5
;;;
;;; Copyright 1991, 1992, 1993, 1994, 1996 by Autodesk, Inc.
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC.
;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;; UNINTERRUPTED OR ERROR FREE.
;;;
;;; Use, duplication, or disclosure by the U.S. Government is subject to
;;; restrictions set forth in FAR 52.227-19 (Commercial Computer
;;; Software – Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;; (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;; 2 February 1992
;;;
;;;—————————————————————————-
;;; DESCRIPTION
;;;—————————————————————————-
;;; C:GG is a dialogue interface for the CHPROP command.
;;;
;;; The command looks similar to DDEMODES. The main dialogue has an image
;;; tile, 3 buttons (layer, color, linetype), and an editbox (thickness).
;;; The 3 buttons each launch a sub-dialogue containing a list and edit box.
;;; The dialogues are all defined in the GG.DCL file.
;;;
;;;
;;;—————————————————————————-
;;;—————————————————————————-
;;; Prefixes in command and keyword strings:
;;; "." specifies the built-in AutoCAD command in case it has been
;;; redefined.
;;; "_" denotes an AutoCAD command or keyword in the native language
;;; version, English.
;;;—————————————————————————-
;;;
;;;
;;; Avoid (gc)s on load to improve load time.
;;;
(defun do_alloc (/ old_allod new_alloc)
(setq old_alloc (alloc 2000) new_alloc (alloc 2000))
(expand (1+ (/ 4750 new_alloc)))
(alloc old_alloc)
)
(do_alloc)
(setq do_alloc nil)
;;;
;;; ===========================================================================
;;; ===================== load-time error checking ============================
;;;
(defun ai_abort (app msg)
(defun *error* (s)
(if old_error (setq *error* old_error))
(princ)
)
(if msg
(alert (strcat " Application error: "
app
" nn "
msg
" n"
)
)
)
(exit)
)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.
(cond
( (and ai_dcl (listp ai_dcl))) ; it's already loaded.
( (not (findfile "ai_utils.lsp")) ; find it
(ai_abort "GG"
(strcat "Can't locate file AI_UTILS.LSP."
"n Check support directory.")))
( (eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "GG" "Can't load file AI_UTILS.LSP"))
)
(if (not (ai_acadapp)) ; defined in AI_UTILS.LSP
(ai_abort "GG" nil) ; a Nil supresses
) ; ai_abort's alert box dialog.
;;; ==================== end load-time operations ===========================
;;; Initialize program subroutines and variables.
(defun GG_init()
;;
;; Define buttons and set values in CHPROP dialogue box
;;
(defun call_chp (/ cmdact)
(if (not (new_dialog "ch_prop" dcl_id)) (exit))
(set_tile "error" "")
;; Set initial dialogue tile values
(set_col_tile)
(if (= elayer "Varies")
(set_tile "t_layer" "Varies")
(set_tile "t_layer" elayer)
)
(cond
((= lt-idx nil)
(set_tile "t_ltype" "Varies")
)
((= lt-idx 0) ; set tile "By layer & layer linetype"
(set_tile "t_ltype" (bylayer_lt))
)
(T
(set_tile "t_ltype" (nth lt-idx ltnmlst))
)
)
(if (or (= ethickness nil)
(= ethickness "VARIES"))
(set_tile "eb_thickness" "Varies")
(set_tile "eb_thickness" (ai_rtos ethickness))
)
(if (or (= eltscale nil)
(= eltscale "VARIES"))
(set_tile "eb_ltscale" "Varies")
(set_tile "eb_ltscale" (ai_rtos eltscale))
)
;; Disable tiles if need be…
(setq a 0)
(while ( < a (sslength ss))
(setq which_tiles
(ai_common_state (cdr (assoc '0 (entget (ssname ss a))))))
;; If all fields are enabled, don't bother checking anymore.
(if (/= which_tiles (logior 1 2 4 8 16))
(setq a (1+ a))
(setq a (sslength ss))
)
)
;; Layer Button and Text Field
(if (/= 1 (logand 1 which_tiles))
(progn
(mode_tile "t_layer" 1)
(mode_tile "b_name" 1)
)
)
;; Color Button and Text Field
(if (/= 2 (logand 2 which_tiles))
(progn
(mode_tile "t_color" 1)
(mode_tile "b_color" 1)
(mode_tile "show_image" 1)
)
)
;; Linetype Button and Text Field
(if (/= 4 (logand 4 which_tiles))
(progn
(mode_tile "t_ltype" 1)
(mode_tile "b_line" 1)
)
)
;; Linetype Scale Edit Field
(if (/= 8 (logand 8 which_tiles))
(progn
(mode_tile "eb_ltscale" 1)
)
)
;; Thickness Edit Field.
(if (/= 16 (logand 16 which_tiles))
(progn
(mode_tile "eb_thickness" 1)
)
)
;; Define action for tiles
(action_tile "b_color" "(setq ecolor (getcolor))")
(action_tile "show_image" "(setq ecolor (getcolor))")
(action_tile "b_name" "(setq elayer (getlayer))")
(action_tile "b_line" "(setq eltype (getltype))")
(action_tile "eb_ltscale" "(getscale $value)")
(action_tile "eb_thickness" "(getthickness $value)")
(action_tile "help" "(help "" "G")")
(action_tile "accept" "(test-main-ok)")
(if (= (start_dialog) 1)
(progn
(setq cmdact (getvar "cmdactive"))
(command "_.chprop" ss "")
(if (/= cmdact (getvar "cmdactive")) ; Is CHPROP actually running?
(progn
;; Only update properties if different to intial values.
(if (and ecolor (/= ecolor ecolor_init))
(progn
(if (= 0 ecolor) (setq ecolor "BYBLOCK"))
(if (= 256 ecolor) (setq ecolor "BYLAYER"))
(command "_c" ecolor)
)
)
(if (and (/= eltype "Varies") lt-idx (/= eltype eltype_init))
(command "_lt" eltype)
)
(if (and (/= elayer "Varies") lay-idx (/= elayer elayer_init))
(command "_la" elayer)
)
(if (and (/= ethickness "Varies") ethickness (/= ethickness ethickness_init))
(command "_t" ethickness)
)
(if (and (/= eltscale "Varies") eltscale (/= eltscale eltscale_init))
(command "_lts" eltscale)
)
(command "")
)
(princ "nProperties unchanged") ; CHPROP didn't like our SS set
)
)
;; Fred GERBER – 25-AUG-94
;; Don't print the "Properties unchanged" message when the user cancels
;; the dialog because he knows that already (otherwise he would have
;; hit the "OK" button). Display the message only if CHPROP fails for
;; some reason, because it is not the expected behavior of the command.
;;
;; (princ "nProperties unchanged")
)
(princ)
)
;;
;; Function to set the Color text tile and swab to the current color value.
;;
(defun set_col_tile()
(cond
((= ecolor nil)
(set_tile "t_color" "Varies")
(col_tile "show_image" 0 nil)
)
((= ecolor 0)
(set_tile "t_color" "BYBLOCK")
(col_tile "show_image" 7 nil) ; show BYBLOCK as white
)
((= ecolor 1)
(set_tile "t_color" "1 red")
(col_tile "show_image" 1 nil)
)
((= ecolor 2)
(set_tile "t_color" "2 yellow")
(col_tile "show_image" 2 nil)
)
((= ecolor 3)
(set_tile "t_color" "3 green")
(col_tile "show_image" 3 nil)
)
((= ecolor 4)
(set_tile "t_color" "4 cyan")
(col_tile "show_image" 4 nil)
)
((= ecolor 5)
(set_tile "t_color" "5 blue")
(col_tile "show_image" 5 nil)
)
((= ecolor 6)
(set_tile "t_color" "6 magenta")
(col_tile "show_image" 6 nil)
)
((= ecolor 7)
(set_tile "t_color" "7 white")
(col_tile "show_image" 7 nil)
)
;; If the color is "BYLAYER", then set the tile to
;; show it's set By layer, but also indicate the
;; color of the layer – i.e. By layer (red)
((= ecolor 256)
(set_tile "t_color" (bylayer_col))
(col_tile "show_image" cn nil)
)
(T
(set_tile "t_color" (itoa ecolor))
(col_tile "show_image" ecolor nil)
)
)
)
;;
;; Function to put up the standard color dialogue.
;;
(defun getcolor(/ col_def lay_clr temp_color)
;; col_def is the default color used when rq_color is called. If ecolor
;; is nil (varies) then set it to 1, else use the value of ecolor.
(if ecolor
(setq col_def ecolor)
(setq col_def 1)
)
;; If we're working with a single layer, get its color
;; for use in the color swatch if the user selects color BYLAYER.
(if (/= elayer "Varies")
(setq lay_clr (cdr (assoc 62 (tblsearch "layer" elayer))))
(setq lay_clr 0)
)
(if (numberp (setq temp_color (acad_colordlg col_def T lay_clr)))
(progn
(setq ecolor temp_color)
(set_col_tile)
ecolor
)
ecolor
)
)
;;
;; This function pops a dialogue box consisting of a list box, image tile,
;; and edit box to allow the user to select or type a linetype. It returns
;; the linetype selected.
;;
(defun getltype (/ old-idx ltname)
;; Initialize a dialogue from dialogue file
(if (not (new_dialog "setltype" dcl_id)) (exit))
(start_list "list_lt")
(mapcar 'add_list ltnmlst) ; initialize list box
(end_list)
(setq old-idx lt-idx)
;; Show initial ltype in image tile, list box, and edit box
(if (/= lt-idx nil)
(ltlist_act (itoa lt-idx))
(progn
(set_tile "edit_lt" "Varies")
(col_tile "show_image" 0 nil)
)
)
(action_tile "list_lt" "(ltlist_act $value)")
(action_tile "edit_lt" "(ltedit_act)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lt)")
(if (= (start_dialog) 1) ; User pressed OK
(cond
((= lt-idx nil)
(set_tile "t_ltype" "Varies")
"Varies"
)
((= lt-idx 0)
(set_tile "t_ltype" (bylayer_lt))
"BYLAYER"
)
((= lt-idx 1)
(set_tile "t_ltype" "BYBLOCK")
"BYBLOCK"
)
(T
(set_tile "t_ltype" ltname)
ltname
)
)
eltype
)
)
;;
;; Edit box entries end up here
;;
(defun ltedit_act ()
;; If linetype name,is valid, then clear error string,
;; call ltlist_act function.
;; Else print error message.
(setq ltvalue (xstrcase (get_tile "edit_lt")))
(if (or (= ltvalue "BYLAYER")
(= ltvalue "BY LAYER"))
(setq ltvalue "BYLAYER")
)
(if (or (= ltvalue "BYBLOCK")
(= ltvalue "BY BLOCK"))
(setq ltvalue "BYBLOCK")
)
(if (setq lt-idx (getindex ltvalue ltnmlst))
(progn
(set_tile "error" "")
(ltlist_act (itoa lt-idx))
)
(progn
(if (/= ltvalue "VARIES")
(set_tile "error" "Invalid linetype.")
)
(setq lt-idx old-idx)
)
)
)
;;
;; List selections end up here
;;
(defun ltlist_act (index / dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lt-idx (atoi index))
(setq ltname (nth lt-idx ltnmlst))
(setq dashdata (nth lt-idx mdashlist))
(col_tile "show_image" 0 dashdata)
(set_tile "list_lt" (itoa lt-idx))
(set_tile "edit_lt" ltname)
)
;;
;; Reset to original linetype when cancel it selected
;;
(defun reset-lt ()
(setq lt-idx old-idx)
(done_dialog 0)
)
;;
;; This function pops a dialogue box consisting of a list box and edit box to
;; allow the user to select or type a layer name. It returns the layer name
;; selected. It also the status (On, Off, Frozen, etc.) of all layer in the
;; drawing.
;;
(defun getlayer (/ old-idx layname on off frozth linetype colname)
;; Create layer list the first time the layer
;; dialogue is called.
(if (not lay-idx)
(progn
(makelaylists) ; layer list – laynmlst
(setq lay-idx (getindex elayer laynmlst))
)
)
;; Load a dialogue from dialogue file
(if (not (new_dialog "setlayer" dcl_id)) (exit))
(start_list "list_lay")
(mapcar 'add_list laynmlst) ; initialize list box
(end_list)
;; Display current layer, show initial layer name in edit
;; box, and highlight list box.
(setq old-idx lay-idx)
(if (/= lay-idx nil) (laylist_act (itoa lay-idx)))
(set_tile "cur_layer" (getvar "clayer"))
(action_tile "list_lay" "(laylist_act $value)")
(action_tile "edit_lay" "(layedit_act)")
(action_tile "accept" "(test-ok)")
(action_tile "cancel" "(reset-lay)")
(if (= (start_dialog) 1) ; User pressed OK
(progn
(if (= lay-idx nil)
(progn (setq layname "VARIES")
(set_tile "t_layer" "Varies"))
(set_tile "t_layer" layname)
)
; If layer or ltype equals bylayer reset their tiles
(if (= lt-idx 0)
(set_tile "t_ltype" (bylayer_lt))
)
(if (= ecolor 256)
(progn
(set_tile "t_color" (bylayer_col))
(col_tile "show_image" cn nil)
)
)
layname
)
elayer
)
)
;;
;; Edit box selections end up here
;;
(defun layedit_act()
;; Convert layer entry to upper case. If layer name is
;; valid, clear error string, call (laylist_act) function,
;; and change focus to list box. Else print error message.
(setq layvalue (xstrcase (get_tile "edit_lay")))
(if (setq lay-idx (getindex layvalue laynmlst))
(progn
(set_tile "error" "")
(laylist_act (itoa lay-idx))
)
(progn
(set_tile "error" "Invalid layer name.")
(setq lay-idx old-idx)
)
)
)
;;
;; List entry selections end up here
;;
(defun laylist_act (index / layinfo color dashdata)
;; Update the list box, edit box, and color tile
(set_tile "error" "")
(setq lay-idx (atoi index))
(setq layname (nth lay-idx laynmlst))
(setq layinfo (tblsearch "layer" layname))
(setq color (cdr (assoc 62 layinfo)))
(setq color (abs color))
(setq colname (colorname color))
(set_tile "list_lay" (itoa lay-idx))
(set_tile "edit_lay" layname)
)
;;
;; Reset to original layer when cancel is selected
;;
(defun reset-lay ()
(setq lay-idx old-idx)
(done_dialog 0)
)
;; Checks validity of linetype scale from edit box. It checks to
;; see if the value equals "Varies".
(defun getscale (value / rval)
(setq value (strcase value)
rval (distof value))
(if (or (= value "VARIES")
(> rval 0.0))
(progn
(set_tile "error" "")
(if (= value "VARIES")
(progn
(set_tile "eb_ltscale" "Varies")
(setq eltscale nil))
(progn
(setq eltscale (distof value))
(set_tile "eb_ltscale" (ai_rtos eltscale))
eltscale)))
(progn
(set_tile "error" "Invalid ltscale.")
nil)))
;;
;; Checks validity of thickness from edit box. Since (atof) returns 0 when a
;; string can't be converted to a real, this routine checks if the first
;; character is "0″. It also checks to see if the value equals "Varies".
;;
(defun getthickness (value)
(setq value (strcase value))
(if (or (= value "VARIES")
(distof value))
(progn
(set_tile "error" "")
(if (= value "VARIES")
(progn
(set_tile "eb_thickness" "Varies")
(setq ethickness nil))
(progn
(setq ethickness (distof value))
(set_tile "eb_thickness" (ai_rtos ethickness))
ethickness)))
(progn
(set_tile "error" "Invalid thickness.")
nil)))
;;
;; This function make a list called laynmlst which consists of all the layer
;; names in the drawing. It also creates a list called longlist which
;; consists of strings which contain the layer name, color, linetype, etc.
;; Longlist is later mapped into the layer listbox. Both are ordered the
;; same.
;;
(defun makelaylists (/ layname sortlist name templist layer_number)
(setq sortlist nil)
(setq templist (tblnext "LAYER" T))
(setq layer_number 1)
(while templist
;; No xref dependent layers, please.
(if (/= (logand 16 (cdr (assoc 70 templist))) 16)
(progn
(setq name (cdr (assoc 2 templist)))
(setq sortlist (cons name sortlist))
)
)
; Get the next layer.
(setq templist (tblnext "LAYER"))
;; Not dead message…
(if (= (/ layer_number 50.0) (fix (/ layer_number 50.0)))
(set_tile "error" (strcat "Collecting…" (itoa layer_number)))
)
(setq layer_number (1+ layer_number))
)
(set_tile "error" "")
(if (>= (getvar "maxsort") (length sortlist))
(progn
(if (> layer_number 50)
(set_tile "error" "Sorting…")
)
(setq sortlist (acad_strlsort sortlist))
)
(setq sortlist (reverse sortlist))
)
(set_tile "error" "")
(setq laynmlst sortlist)
)
;;
;; This function makes 2 lists – ltnmlst & mdashlist. Ltnmlst is a list of
;; linetype names read from the symbol table. Mdashlist is list consisting
;; of lists which define the linetype pattern – numbers that indicate dots,
;; dashes, and spaces taken from group code 49. The list corresponds to the
;; order of names in ltnmlst.
;;
(defun makeltlists (/ ltlist ltname)
(setq mdashlist nil)
(setq sortlist nil)
(setq ltype_number 1)
(setq ltlist (tblnext "LTYPE" T))
;;(setq ltname (cdr (assoc 2 ltlist)))
;;(setq ltnmlst (list ltname))
(while ltlist
;; No xref dependent linetypes, please.
(if (/= (logand 16 (cdr (assoc 70 ltlist))) 16)
(progn
(setq ltname (cdr (assoc 2 ltlist)))
(setq sortlist (cons ltname sortlist))
)
)
;; Get the next linetype.
(setq ltlist (tblnext "LTYPE"))
;; Not dead message…
(if (= (/ ltype_number 50.0) (fix (/ ltype_number 50.0)))
(set_tile "error" (strcat "Collecting…" (itoa ltype_number)))
)
(setq ltype_number (1+ ltype_number))
)
;; Remove Collecting message.
(set_tile "error" "")
;; Sort based on maxsort.
(if (>= (getvar "maxsort") (length sortlist))
(progn
(if (> ltype_number 50)
(set_tile "error" "Sorting…")
)
(setq sortlist (acad_strlsort sortlist))
)
(setq sortlist (reverse sortlist))
)
(set_tile "error" "")
(setq ltnmlst sortlist)
(foreach ltname ltnmlst
(setq ltlist (tblsearch "LTYPE" ltname))
(if (= ltname "CONTINUOUS")
(setq mdashlist (append mdashlist (list "CONT")))
(setq mdashlist
(append mdashlist (list (add-mdash ltlist)))
)
)
)
(setq ltnmlst (cons "BYBLOCK" ltnmlst))
(setq mdashlist (cons nil mdashlist))
(setq ltnmlst (cons "BYLAYER" ltnmlst))
(setq mdashlist (cons nil mdashlist))
)
;;
;; Get all the group code 49 values for a linetype and put them in a list
;; (pen-up, pen-down info)
;;
(defun add-mdash (ltlist1 / dashlist assoclist dashsize)
(setq dashlist nil)
(while (setq assoclist (car ltlist1))
(if (= (car assoclist) 49)
(progn
(setq dashsize (cdr assoclist))
(setq dashlist (cons dashsize dashlist))
)
)
(setq ltlist1 (cdr ltlist1))
)
(setq dashlist (reverse dashlist))
)
;;
;; Color a tile, draw linetype, and draw a border around it
;;
(defun col_tile (tile color patlist / x y)
(setq x (dimx_tile tile))
(setq y (dimy_tile tile))
(start_image tile)
(fill_image 0 0 x y color)
(if (= color 7)
(progn
(if patlist (drawpattern x (/ y 2) patlist 0))
(tile_rect 0 0 x y 0)
)
(progn
(if patlist (drawpattern x (/ y 2) patlist 7))
(tile_rect 0 0 x y 7)
)
)
(end_image)
)
;;
;; Draw a border around a tile
;;
(defun tile_rect (x1 y1 x2 y2 color)
(setq x2 (- x2 1))
(setq y2 (- y2 1))
(vector_image x1 y1 x2 y1 color)
(vector_image x2 y1 x2 y2 color)
(vector_image x2 y2 x1 y2 color)
(vector_image x1 y2 x1 y1 color)
)
;;
;; Draw the linetype pattern in a tile. Boxlength is the length of the image
;; tile, y2 is the midpoint of the height of the image tile, pattern is a
;; list of numbers that define the linetype, and color is the color of the
;; tile.
;;
(defun drawpattern (boxlength y2 pattern color / x1 x2
patlist dash)
(setq x1 0 x2 0)
(setq patlist pattern)
(setq fx 30)
(if (= patlist "CONT")
(progn
(setq dash boxlength)
(vi)
(setq x1 boxlength)
)
(foreach dash patlist
(if (> (abs dash) 2.5)
(setq fx 2)
)
)
)
(while (< x1 boxlength)
(if (setq dash (car patlist))
(progn
(setq dash (fix (* fx dash)))
(cond
((= dash 0)
(setq dash 1)
(vi)
)
((> dash 0)
(vi)
)
(T
(if (< (abs dash) 2) (setq dash 2))
(setq x2 (+ x2 (abs dash)))
)
)
(setq patlist (cdr patlist))
(setq x1 x2)
)
(setq patlist pattern)
)
)
)
;;
;; Draw a dash or dot in image tile
;;
(defun vi ()
(setq x2 (+ x2 dash))
(vector_image x1 y2 x2 y2 color)
)
;; This function takes a selection and returns a list of the color,
;; linetype, layer, linetype scale, and thickness properties that
;; are common to every entities in the selection set – (color
;; linetype layer thickness). If all entities do not share the same
;; property value it returns "Varies" in place of the property
;; value. i.e. ("BYLAYER" "DASHED" "Varies" 0)
(defun getprops (selset / sslen elist color ltype layer ltscale thickness
go ctr)
(setq sslen (sslength selset)
elist (entget (ssname selset 0))
color (cdr (assoc 62 elist))
ltype (cdr (assoc 6 elist))
layer (cdr (assoc 8 elist))
ltscale (cdr (assoc 48 elist)))
(if (/= nil (assoc 39 elist))
(setq thickness (cdr (assoc 39 elist)))
(setq thickness 0.0)
)
(if (not color)
(setq color 256))
(if (not ltype)
(setq ltype "BYLAYER"))
(if (not thickness)
(setq thickness 0))
(if (not ltscale)
(setq ltscale 1))
(setq go T chk-col T chk-lt T chk-lay T chk-lts T chk-th T ctr 1)
;; Page through the selection set. When a property
;; does not match, stop checking for that property.
;; If all properties vary, stop paging.
(while (and (> sslen ctr) go)
(setq elist (entget (setq en (ssname selset ctr))))
(if chk-col (match-col))
(if chk-lt (match-lt))
(if chk-lay (match-lay))
(if chk-lts (match-lts))
(if chk-th (match-th))
(setq ctr (1+ ctr))
(if (and (not chk-col)
(not chk-lt)
(not chk-lay)
(not chk-lts)
(not chk-th))
(setq go nil)
)
)
(list color ltype layer thickness ltscale)
)
(defun match-col (/ ncolor)
(setq ncolor (cdr (assoc 62 elist)))
(if (not ncolor) (setq ncolor 256))
(if (/= color ncolor)
(progn
(setq chk-col nil)
(setq color nil)
)
)
)
(defun match-lt (/ nltype)
(setq nltype (cdr (assoc 6 elist)))
(if (not nltype) (setq nltype "BYLAYER"))
(if (/= ltype nltype)
(progn
(setq chk-lt nil)
(setq ltype "Varies")
)
)
)
(defun match-lay (/ nlayer)
(setq nlayer (cdr (assoc 8 elist)))
(if (/= layer nlayer)
(progn
(setq chk-lay nil)
(setq layer "Varies")
)
)
)
(defun match-th (/ nthickness)
(if (/= nil (assoc 39 elist))
(setq nthickness (cdr (assoc 39 elist)))
(setq nthickness 0.0)
)
(if (not nthickness) (setq nthickness 0))
(if (/= thickness nthickness)
(progn
(setq chk-th nil)
(setq thickness "Varies")
)
)
)
(defun match-lts (/ nltscale)
(setq nltscale (cdr (assoc 48 elist)))
(if (not nltscale) (setq nltscale 1))
(if (/= ltscale nltscale)
(progn
(setq chk-lts nil)
(setq ltscale "Varies")
)
)
)
;;
;; If an item is a member of the list, then return its index number, else
;; return nil.
;;
(defun getindex (item itemlist / m n)
(setq n (length itemlist))
(if (> (setq m (length (member item itemlist))) 0)
(- n m)
nil
)
)
;;
;; This function is called if the linetype is set "BYLAYER". It finds the
;; ltype of the layer so it can be displayed beside the linetype button.
;;
(defun bylayer_lt (/ layname layinfo ltype)
(if lay-idx
(progn
(setq layname (nth lay-idx laynmlst))
(setq layinfo (tblsearch "layer" layname))
(setq ltype (cdr (assoc 6 layinfo)))
(strcat "BYLAYER" " (" ltype ")")
)
"BYLAYER"
)
)
;;
;; This function is called if the color is set "BYLAYER". It finds the
;; color of the layer so it can be displayed beside the color button.
;;
(defun bylayer_col (/ layname layinfo color)
(if lay-idx
(progn
(setq layname (nth lay-idx laynmlst))
(setq layinfo (tblsearch "layer" layname))
(setq color (abs (cdr (assoc 62 layinfo))))
(setq cn color)
(strcat "BYLAYER" " (" (colorname color) ")")
)
(progn
(setq layname elayer)
(if (/= elayer "Varies")
(progn
(setq layinfo (tblsearch "layer" elayer))
(setq color (abs (cdr (assoc 62 layinfo))))
(setq cn color)
(strcat "BYLAYER" " (" (colorname color) ")")
)
(progn
(setq cn 0)
"BYLAYER"
)
)
)
)
)
;;
;; If there is no error message, then close the dialogue
;;
;; If there is an error message, then set focus to the tile
;; that's associated with the error message.
;;
(defun test-ok ( / errtile)
(setq errtile (get_tile "error"))
(cond
( (= errtile "")
(done_dialog 1))
( (= errtile "Invalid thickness.")
(mode_tile "eb_thickness" 2))
)
)
;;
;; OK in main dialogue.
;;
(defun test-main-ok ()
(cond
( (not (or (distof (get_tile "eb_thickness"))
(= (strcase "Varies")
(strcase (get_tile "eb_thickness")))
)
)
(set_tile "error" "Invalid thickness.")
(mode_tile "eb_thickness" 2)
)
( (not (or (< 0 (distof (get_tile "eb_ltscale")))
(= (strcase "Varies")
(strcase (get_tile "eb_ltscale")))
)
)
(set_tile "error" "Invalid ltscale.")
(mode_tile "eb_ltscale" 2)
)
( T (done_dialog 1))
)
)
;;
;; A color function used by getlayer.
;;
(defun colorname (colnum)
(setq cn (abs colnum))
(cond ((= cn 1) "red")
((= cn 2) "yellow")
((= cn 3) "green")
((= cn 4) "cyan")
((= cn 5) "blue")
((= cn 6) "magenta")
((= cn 7) "white")
(T (itoa cn))
)
)
;;; Construct layer and ltype lists and initialize all
;;; program variables:
; (makelaylists) ; layer list – laynmlst
(makeltlists) ; linetype lists – ltnmlst, mdashlist
;; Find the property values of the selection set.
;; (getprops ss) returns a list of properties from
;; a selection set – (color ltype layer thickness).
(setq proplist (getprops ss)
ecolor (car proplist)
eltype (nth 1 proplist)
elayer (nth 2 proplist)
ethickness (nth 3 proplist)
eltscale (nth 4 proplist))
;; Store the intial value of each property.
(setq ecolor_init ecolor)
(setq eltype_init eltype)
(setq elayer_init elayer)
(setq ethickness_init ethickness)
(setq eltscale_init eltscale)
;; Find index of linetype, and layer lists
(cond
((= eltype "Varies") (setq lt-idx nil))
((= eltype "BYLAYER")
(setq lt-idx (getindex "BYLAYER" ltnmlst)))
((= eltype "BYBLOCK")
(setq lt-idx (getindex "BYBLOCK" ltnmlst)))
(T (setq lt-idx (getindex eltype ltnmlst)))
)
(if (= elayer "Varies")
(setq lay-idx nil)
(setq lay-idx (getindex elayer laynmlst))
)
(if (= ethickness "Varies")
(setq ethickness nil)
)
(if (= eltscale "Varies")
(setq eltscale nil)
)
) ; end (ddchprop_init)
;;; (ddchprop_select)
;;;
;;; Aquires selection set for G, in one of three ways:
;;;
;;; 1 – Autoselected.
;;; 2 – Prompted for.
;;; 3 – Passed as an argument in a call to (G )
;;;
;;; The (G_select) function also sets the value of the
;;; global symbol AI_SELTYPE to one of the above three values to
;;; indicate the method thru which the entity was aquired.
(defun GG_select ()
(cond
( (and ss (eq (type ss) 'pickset)) ; selection set passed to
(cond ; (G) as argument
( (not (zerop (sslength ss))) ; If not empty, then
(setq ai_seltype 3) ; then return pickset.
(ai_return ss))))
( (ai_aselect)) ; Use current selection
; set or prompt for objects
(t (princ "nNothing selected.")
(ai_return nil))
)
)
;;; Define command function.
(defun C:GG ()
(G nil)
(princ)
)
;;; Main program function – callable as a subroutine.
;;;
;;; (GG )
;;;
;;; is the selection set of objects to be changed.
;;;
;;; If is nil, then the current selection set is
;;; aquired, if one exists. Otherwise, the user is prompted
;;; to select the objects to be changed.
;;;
;;; Before (GG) can be called as a subroutine, it must
;;; be loaded first. It is up to the calling application to
;;; first determine this, and load it if necessary.
(defun GG (ss /
add-mdash ecolor ltedit_act s
assoclist elayer ltidx selset
bit-70 elist ltlist set_col_tile
boxlength eltype ltlist1
bylayer-lt en ltlist_act sortlist
bylayer_col ethickness ltname
bylayer_lt fchk ltnmlst sslen
call_chp frozth ltvalue templist
chk-col getcolor ltype temp_color
chk-lay getindex m test-ok
chk-lt getlayer makelaylists testidx
chk-th getltype makeltlists testlay
cmd getprops match-col th-value
cmdecho getthickness match-in thickness
cn globals match-lay tile
cnum match-lt tilemode
col-idx index match-th tile_rect
colname item match_col vi
colnum item1 mdashlist vpf
color item2 n vpldata
colorname itemlist name vpn
col_def lay-idx ncolor x
col_tile layedit_act nlayer x1
layer nltype x2
cvpname layinfo nthickness xdlist
dash laylist off y
dashdata laylist_act old-idx y1
dashlist layname olderr y2
dashsize laynmlst on undo_init
dcl_id layvalue onoff fx
test-main-ok linetype patlist which_tiles
G-err list1 pattern a
longlist proplist eltscale_init elayer_init
lt-idx reset-lay eltype_init ecolor_init
drawpattern ltabstr reset-lt ethickness_init
eltscale match-lts
)
(setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
old_error *error* ; save current error function
*error* ai_error ; new error function
)
(setvar "cmdecho" 0)
(cond
( (not (ai_notrans))) ; Not transparent?
( (not (ai_acadapp))) ; ACADAPP.EXP xloaded?
( (not (setq dcl_id (ai_dcl "G")))) ; is .DCL file loaded?
( (not (setq ss (G_select)))) ; objects to modify?
(t (ai_undo_push)
(G_init) ; Everything's cool,
(call_chp) ; so proceed!
(ai_undo_pop)
)
)
(setq *error* old_error)
(setvar "cmdecho" old_cmd)
(princ)
)
;;;—————————————————————————-
(princ " GG loaded.")
(princ)
리습을 올려야 했는지 몰랐네요…ㅎ;;;
다들 쓰시는줄 알고…죄송요~