프로그램
캐드 분류

zwcad 사용하고 계시는분이요…auto리습잘쓴던게 안되네요…

컨텐츠 정보

  • 243 조회
  • 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)




리습을 올려야 했는지 몰랐네요…ㅎ;;;
다들 쓰시는줄 알고…죄송요~

관련자료

댓글 4 / 1 페이지

수야12님의 댓글

대안 캐드에서 안되는 경우는 2가지정도  command 문 순서상의 문제와 비주얼리습 구문인식 불가 

전체 7,232 / 457 페이지
번호
제목
이름
게시물이 없습니다.

최근글


새댓글


알림 0