[编程交流] 需要线型和/或LISP

;will draw a single line composed of three lines, width is equal to 1
;base=1"
;it may contain extra code for any pipe size 
(defun C:storm1 ()
(setq om (getvar "osmode"))
(setq or (getvar "orthomode"))
(setvar "cmdecho" 0)
(setq p1 (getpoint "\nPick first point.. "))
(setq p2 (getpoint "\nPick second point.. "))
(setvar "osmode" 0)
(setvar "orthomode" 0)
(command "ucs" pt1 pt2 "")
(setq p3 (polar p1 90 0.5))
(setq p5 (polar p1 270 0.5))
(setq p4 (polar p2 90 0.5))
(setq p6 (polar p2 270 0.5))
(command "line" p3 p4 "")
(command "line" p5 p6 "")
(command "_.-linetype" "load" "hidden2" (strcat "C:/archivos de programa/AutoCAD 2009/UserDataCache/Support/acad.lin") "" "")
(command "_.-linetype" "set" "hidden2" "")
(command "pline" p1 "W" "1" "1" p2 "")
(command "_.-linetype" "set" "bylayer" "")
(command "ucs" "w")
(setvar "osmode" om)
(setvar "orthomode" or)
(setvar "cmdecho" 1)
(princ)
)

                               
登录/注册后可看大图

;original coding taken from Pipe.lsp, created by Tim Wilson (9.11.95, revised 6.22.97)
;modified by alan thompson (11.18.08) for use at Capital Engineering and Surveying, Inc.
;    1. created 2 routines (SSD & PSD)
;        a. SSD will create an existing (Survey) storm pipe on the "V-STRM-PIPE" layer with a hidden2 linetype.
;           (if layer and/or linetype do not exist, they are created/loaded)
;        b. PSD will create a proposed (Engineering) storm pipe on the "C-STRM-PIPE" layer with a continuous linetype.
;           (if layer and/or linetype do not exist, they are created/loaded)
;    2. added error handler
;    3. removed unnecessary code, formatted and cleaned up code
;    4. localized subroutines
;thank you Tim Wilson for the borrowed coding.
;;Survey STORM
(defun C:SSD (/ *error* DTR PNT1 PNT2 D D2 A ET HD L1 L2 L3 L4 OTM c_layer my_linfile my_layer my_color my_ltype )
(vl-load-com)
;;;;;SUB ROUTINES;;;;;
(defun *error* (msg)
msg
(setvar "clayer" c_layer)
(setvar "orthomode" OTM)
);defun
(defun DTR (a)
(* PI (/ A 180.0))
)
;;;;;MAIN ROUTINE;;;;;
(setq my_linfile "CES.lin")    ;linetype file to reference (if using default acad.lin, set as: nil)
(setq my_layer "V-STRM-PIPE")    ;layer to use
(setq my_color 172)        ;color to use
(setq my_ltype "hidden2")    ;linetype to use
(setq c_layer (getvar "clayer"))
(setq OTM (getvar "orthomode"))
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(if (and
      (not (= my_linfile nil))
      (findfile my_linfile)
      (not (tblsearch "ltype" my_ltype))
    );and
     (vl-cmdf "_.linetype" "_l" my_ltype my_linfile "")
);if
(if (and
      (setq PNT1 (getpoint "\nPick Start of Pipe: "))
      (setq PNT2 (getpoint pnt1 "\nPick End of Pipe: "))
      (setq D (getdist "\nEnter Pipe Width: ")) ;In INCHES IE 24", 30", 42" SO ON
    );and
      (progn
        (if (tblsearch "layer" my_layer)
          (vl-cmdf "_.layer" "_t" my_layer "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "")
          (vl-cmdf "_.layer" "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "")
        );if
        (setq D2 (/ D 12))
        (SETQ D D2)
        (while Pnt2
          (setq HD (/ D 2))
          (setq A (angle PNT1 PNT2))
          (setq ET (entlast))
          (setq L1 (polar pnt1 (- a (dtr 90)) HD))
          (setq L2 (polar pnt2 (- a (dtr 90)) HD))
          (setq L3 (polar pnt1 (+ a (dtr 90)) HD))
          (setq L4 (polar pnt2 (+ a (dtr 90)) HD))
          (vl-cmdf "_.line" "_non" L1 "_non" L2 "" "_.line" "_non" L3 "_non" L4 "")
          (setq PNT1 PNT2)
          (setq PNT2 (getpoint PNT1 "\nNext Point: <Return or Enter to Quit> "))
        );while
        (setvar "clayer" c_layer)
        (setvar "orthomode" OTM)
      );progn
);if
(princ)
);defun
;;Proposed STORM
(defun C:PSD (/ *error DTR PNT1 PNT2 D D2 A ET HD L1 L2 L3 L4 OTM c_layer my_linfile my_layer my_color my_ltype my_ltype_mid )
(vl-load-com)
;;;;;SUB ROUTINES;;;;;
(defun *error* (msg)
msg
(setvar "clayer" c_layer)
(setvar "orthomode" OTM)
);defun
(defun DTR (a)
(* PI (/ A 180.0))
)
;;;;;MAIN ROUTINE;;;;;
(setq my_linfile nil)        ;linetype file to reference (if using default acad.lin, set as: nil)
(setq my_layer "C-STRM-PIPE")    ;layer to use
(setq my_color 2)        ;color to use
(setq my_ltype "continuous")    ;linetype to use for exterior lines
(setq my_ltype_mid "hidden")    ;linetype to use for interior line (pline with width of pipe)
(setq c_layer (getvar "clayer"))
(setq OTM (getvar "orthomode"))
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
;load my_ltype
(if (and
      (not (= my_linfile nil))
      (findfile my_linfile)
      (not (tblsearch "ltype" my_ltype))
    );and
     (vl-cmdf "_.linetype" "_l" my_ltype my_linfile "")
);if
;load my_ltype_mid
(if (and
      (not (= my_linfile nil))
      (findfile my_linfile)
      (not (tblsearch "ltype" my_ltype_mid))
    );and
     (vl-cmdf "_.linetype" "_l" my_ltype_mid my_linfile "")
);if
(if (and
      (setq PNT1 (getpoint "\nPick Start of Pipe: "))
      (setq PNT2 (getpoint PNT1 "\nPick End of Pipe: "))
      (setq D (getdist "\nEnter Pipe Width: ")) ;In INCHES IE 24", 30", 42" SO ON
    );and
      (progn
        (if (tblsearch "layer" my_layer)
          (vl-cmdf "_.layer" "_t" my_layer "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "")
          (vl-cmdf "_.layer" "_m" my_layer "_c" my_color my_layer "_lt" my_ltype my_layer "")
        );if
        (setq D2 (/ D 12))
        (setq D D2)
        (while Pnt2
           (setq HD (/ D 2))
           (setq A (angle PNT1 PNT2))
           (vl-cmdf "_.pline" "non" PNT1 "non" PNT2 "")
           (setq ET (entlast))
           (setq L1 (polar pnt1 (- a (dtr 90)) HD))
           (setq L2 (polar pnt2 (- a (dtr 90)) HD))
           (setq L3 (polar pnt1 (+ a (dtr 90)) HD))
           (setq L4 (polar pnt2 (+ a (dtr 90)) HD))
           (vl-cmdf "_.line" "non" L1 "non" L2 "" "line" "non" L3 "non" L4 "")
           (vl-cmdf "_.change" ET "" "_p" "_lt" my_ltype_mid "") ;change linetype to suit
           (vl-cmdf "_.pedit" ET "_w" D "")
           (setq PNT1 PNT2)
           (setq PNT2 (getpoint PNT1 "\nNext Point: <Return or Enter to Quit>: "))
        );while
      );progn
);if
(setvar "orthomode" OTM)
(setvar "clayer" c_layer)
(princ)
);defun