[编程交流] 帮助用di画双线

 
; 11/13/04 4:06 PM
;Draw two lines;
(defun C:TWOLINES (/ *error* adoc cline cmde dia
erro mdsp osmd pbx pt ptlist rad )
;_____________________________;
(setq cmde (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_G")
(setq osmd (getvar "osmode"))
(setvar "osmode" 0)
(setq pbx (getvar "pickbox"))
(setvar "pickbox" 4)
(setq erro *error*)
(defun *error* (msg)
(setq *error* erro)
(setvar "osmode" osmd) 
(command "_.undo" "_E")
(setvar "cmdecho" cmde)
(setvar "pickbox" pbx) 
(if 
(or 
(= msg "Function cancelled")
(= msg "quit / exit abort") 
)
(princ)
(princ (strcat "\nError: " msg))
)
)
; Helper function
(defun safefill (lst ) 
(vlax-safearray-fill (vlax-make-safearray 
vlax-vbDouble
(cons 0 (- (length (apply 'append lst))1)))
(apply 'append lst))); eof safefill
(vl-load-com)
(setq adoc 
(vla-get-activedocument 
(vlax-get-acad-object))
mdsp (vla-get-modelspace adoc))
(setq dia (getreal "\nDiameter (or Wall Width): ") rad (/ dia 2.0))
(setq pt (getpoint "\nSpecify start point: "))
(setq ptlist (cons pt ptlist))
(while (setq pt1 (getpoint pt "\nSpecify next point: " ))
(grdraw pt pt1 1 -1)
(setq ptlist (cons pt1 ptlist))
(setq pt pt1)
)
(setq cline (vla-addPolyline mdsp (safefill ptlist)))
(vla-put-layer cline "liquid")
(vla-put-color cline 256)
;(vla-offset cline (- rad))
(vla-offset cline rad)
(vla-put-color cline 256)
(vla-put-layer cline "gas")
(vla-put-linetypescale cline dia);<-- to your suit
(vla-regen adoc acActiveViewport)
(princ)
(setq *error* erro)
(setvar "osmode" osmd)
(command "_.undo" "_E")
(setvar "cmdecho" cmde)
(setvar "pickbox" pbx)
(princ)
); eof 
(princ "\nStart command with "TWOLINES" ")
(princ)