[编程交流] 可自定义多段线

(defun load_ltype (ltname / fname);FH
 (if (not (tblsearch "ltype" ltname))
 (and
   (if (zerop (getvar "measureinit"))
   (setq fname "acad.lin")
   (setq fname "acadiso.lin")
 )
 (vl-cmdf "._-linetype" "_L" ltname (findfile fname) "")
   )
 )
 (princ)
 )
(load_ltype "ACAD_ISO02W100")
(defun c:demo (/ *error* cnt curcol curlr curlts elist en osm pt pts )
 ;; Application error handler by Doug Broad 
(defun *error*  (msg)
   ; create standard error handler
     (cond ((not msg))      ; normal exit, no error
    ((member msg '("Function cancelled" "quit / exit abort"))
    ( ) ) ; escape
    ((princ (strcat "\nError: " msg))   ; display fatal error
     ))    
     (setvar "cmdecho" 1)                        ; restore environments
   (if osm (setvar "osmode" osm))
 (if curlr (setvar "clayer" curlr))
 (if curcol (setvar "cecolor" curcol))
 (if curlts (setvar "celweight" curlts))
     (command "._layerp" ) 
     (command "._undo" "_end")
 (princ)
     )
 (setvar "cmdecho" 0) ; turn echo off
(command "._Undo" "_end") ; close any open group
 (command "._undo" "_begin")
 (load_ltype "ACAD_ISO02W100")
 (command "_.-layer" "_Th" "*" "")
 (setq osm (getvar "osmode"))
 (setq curlr (getvar "clayer"))
 (setq curcol (getvar "cecolor"))
 (setq curlts (getvar "celweight"))
 (setvar "cmdecho" 0)
 (setvar "clayer" "0")
 (setvar "cecolor" "1")
 (command "_celtype" "ACAD_ISO02W100")
 (setvar "celweight" 53)
 (setvar "celtscale" 0.05)
 (setq pts nil)
 (if (setq pt (getpoint "\nPick first Point: "))
   (progn
   (setq pts (cons pt pts))
     (command "_.pline" "_non" pt "_W" "0.0" "0.0")
     (while (setq pt (getpoint "\nPick next point: " pt))
(setq pts (cons pt pts))
(command "_non" pt))
     (command "")))
 (command "_celtype" "continuous")
 (setvar "cecolor" "256")
(foreach p pts
 (command "_.-insert"  "block-1"  p "1.0" "1.0" "0.0"))
 (setq pts (reverse pts)
cnt 1)
 (setvar "celtscale" 1.0)
 (setvar "cecolor" "7")
 ( while  (cadr pts)
(command "dimaligned" (car pts) (cadr pts) (polar (cadr pts) (* pi 1.5)0.05))
   (setq en (entlast))
   (setq elist (entget en))
   (setq elist (entmod (subst (cons 1 (strcat"{\\C3;" (itoa cnt) "}\\P\\C7;<>"))(assoc 1 elist)elist)))
   (entmod (subst (cons 41 1.5)(assoc 41 elist)elist))
   (entupd en)
   (setq pts(cdr pts)
  cnt (1+ cnt)))
(*error* nil)
 (princ)
 )
(prompt"\n\t\t>> Type DEMO to execute")
(prin1)