aggdqty 发表于 2023-6-6 22:19:08

提问-单线变双线图层不能设置

请教一下，为什么下面程序无法更改图层，


[*](defun myerr (s)
[*](if (/= s "Function cancelled")
[*]    (princ (strcat "\nError: " s)))
[*](if _oc (setvar "cmdecho" _oc))
[*](setq *error* olderr)
[*](princ)
[*])
[*]
[*](if wid nil (setq wid 240.0))
[*](defun CSDBL(/ ss _oc ssl yn llay tllay)
[*](setq _oc (getvar "cmdecho"))
[*](setvar "cmdecho" 0)
[*](setq olderr *error* *error* myerr)
[*](setq llay (getvar "clayer"))
[*](command "undo" "group")
[*](graphscr)
[*](setq ss0 (ssget '((0 . "LINE"))) cont 0)
[*](if ss0
[*]    (progn
[*]      (setq ssl (sslength ss0))
[*]      (initget "Yes No")
[*]      (setq yn (getkword "是否改变变双后线的图层<Y>: "))
[*]      (if (or (= yn "") (= yn nil))
[*]      (progn
[*]          (setq tllay (getstring (strcat "请输入图层名<" llay ">: ")))
[*]          (if (/= tllay "") (setq llay tllay))
[*]      )
[*]      )
[*]      (setq twid (getreal (strcat "请输入变双后双线间的宽度<" (rtos wid 2) ">: ")))
[*]      (if twid (setq wid twid))
[*]      (setq hwid (/ wid 2.0))
[*]      (if (> ssl 30)
[*]      (progn
[*]          (princ)
[*]          (princ "\n程序正在执行中 -- 稍待...")
[*]      )
[*]      )
[*]      (while (setq el (ssname ss0 cont))
[*]       (cond ((= "LINE" (cdr (assoc 0 (entget el)))) (dbl hwid))
[*]             (t (setq ss0 (ssdel el ss0) cont (1- cont)))
[*]       )
[*]       (setq cont (1+ cont))
[*]      )
[*]    )
[*]    (princ "\n没有选到任何实体")
[*])
[*](command "undo" "end")
[*](if _oc (setvar "cmdecho" _oc))
[*](princ)
[*])
[*]
[*];;;Get insective point's max distance
[*](defun gtl (p1 p2 / p3 p4 an1 mx mn c1 ipt n )
[*](setq n (length clst) mx -1200000.0 mn 1200000.0 c1 0)
[*](repeat n      
[*]   (setq el0 (entget (ssname ss (nth c1 clst)))
[*]         w1 (gthw (ssname ss (nth c1 clst)))
[*]         p3 (cdr (assoc 10 el0)) p4 (cdr (assoc 11 el0))
[*]         an1 (angle p3 p4)
[*]   )
[*]   (if (setq ipt (inters p1 p2 (polar p3 (+ an1 (/ pi 2)) hwid)
[*]                            (polar p4 (+ an1 (/ pi 2)) hwid)))
[*]    (setq ipt (distance p1 ipt) mn (min mn ipt) mx (max mx ipt))
[*]    (if (setq ipt (inters p1 p2 (polar p3 (+ an1 (/ pi 2)) hwid)
[*]                            (polar p4 (+ an1 (/ pi 2)) hwid) nil))
[*]   (if (/= (+ (distance p1 ipt) (distance ipt p2)) (distance p1 p2))
[*]      (setq ipt (- (distance ipt p1)) mn (min mn ipt) mx (max mx ipt))
[*]   )
[*]   (setq mx (max 0.0 mx))
[*]    )
[*]   )
[*]   (if (setq ipt (inters p1 p2 (polar p3 (- an1 (/ pi 2)) hwid)
[*]                            (polar p4 (- an1 (/ pi 2)) hwid)))
[*]    (setq ipt (distance p1 ipt) mn (min mn ipt) mx (max mx ipt))
[*]    (if (setq ipt (inters p1 p2 (polar p3 (- an1 (/ pi 2)) hwid)
[*]                        (polar p4 (- an1 (/ pi 2)) hwid) nil))
[*]   (if (/= (+ (distance p1 ipt) (distance ipt p2)) (distance p1 p2))
[*]      (setq ipt (- (distance ipt p1)) mn (min mn ipt) mx (max mx ipt))
[*]   )
[*]   (setq mx (max 0.0 mx))
[*]    )
[*]   )
[*]   (setq c1 (1+ c1))
[*])   ;;;end repeat
[*](list mx mn)
[*])
[*]
[*](defun dbl(hwid / ss pt1 pt2 pt3 pt4 ipt
[*]               n1 el0 ang c1 plst clst)
[*](setq el (entget el)
[*]      pt1 (cdr (assoc 10 el)) pt2 (cdr (assoc 11 el))
[*]      ang (angle pt1 pt2) c1 0 plst () ld (distance pt1 pt2)
[*]      el (subst (cons 8 llay) (assoc 8 el) el)
[*])
[*](setq ss (ssdel (cdr (assoc -1 el))
[*]   (ssget "c" (mapcar '+ '(20 20) (mapcar 'max pt1 pt2))
[*]                (mapcar '- (mapcar 'min pt1 pt2) '(20 20))
[*])))
[*](while (setq el0 (ssname ss c1))
[*]   (cond
[*]    ((and (= "LINE" (cdr (assoc 0 (entget el0)))) (ssmemb el0 ss0))
[*]      (setq dt nil el0 (entget el0)
[*]            pt3 (cdr (assoc 10 el0)) pt4 (cdr (assoc 11 el0)))
[*]      (if (setq ipt (inters pt1 pt2 pt3 pt4))
[*]      (cond ((equal ipt pt1 0.1) (setq dt ld))
[*]            ((equal ipt pt2 0.1) (setq dt 0.0))
[*]            (t(setq dt (distance ipt pt2)))
[*]      );end cond
[*]      )
[*]      (if dt
[*]       (if (setq clst (assoc dt plst))
[*]      (setq plst (subst (append clst (list c1)) clst plst))
[*]      (setq plst (cons (list dt c1) plst))
[*]      ))
[*]    );;end of line
[*]   );end of cond
[*]   (setq c1 (1+ c1))
[*]) ;end while
[*](setq pt1 (polar pt1 (+ ang (/ pi 2)) hwid)
[*]      pt2 (polar pt2 (+ ang (/ pi 2)) hwid)
[*]      pt3 (polar pt1 (- ang (/ pi 2)) (* 2 hwid))
[*]      pt4 (polar pt2 (- ang (/ pi 2)) (* 2 hwid))
[*])
[*](if plst (progn
[*]    (setq t1 0)
[*]    (while (< -1.0 (setq dt (apply 'max (mapcar 'car plst))))
[*]   (setq clst (cdr (assoc dt plst))
[*]         plst (subst '(-1 0) (assoc dt plst) plst)
[*]   )
[*]   (cond
[*]      ((= dt ld) (setq t1 1)
[*]       (setq dt (gtl pt1 pt2) pt1 (polar pt1 ang (car dt))
[*]             dt (gtl pt3 pt4) pt3 (polar pt3 ang (car dt)))
[*]      )
[*]      ((= dt 0.0)
[*]       (if (= t1 0)
[*]      (setq el (subst (cons 10 pt1) (assoc 10 el) el)
[*]            el (subst (cons 11 pt3) (assoc 11 el) el)
[*]            el (entmake el) t1 1
[*]       ))
[*]       (setq t1 2)
[*]       (setq dt (gtl pt2 pt1) pt2 (polar pt2 (+ ang pi) (car dt))
[*]             dt (gtl pt4 pt3) pt4 (polar pt4 (+ ang pi) (car dt)))
[*]      )
[*]      (t (if (= t1 0)
[*]      (setq el (subst (cons 10 pt1) (assoc 10 el) el)
[*]            el (subst (cons 11 pt3) (assoc 11 el) el)
[*]            el (entmake el) t1 1
[*]      ))
[*]       (if (< (car clst) 0.0)
[*]      (setq ipt (polar pt2 ang (+ (- dt) (car clst)))
[*]            el (subst (cons 10 pt1) (assoc 10 el) el)
[*]            el (subst (cons 11 ipt) (assoc 11 el) el)
[*]            el (entmake el)
[*]            dt (polar pt4 ang (+ (- dt) (car clst)))
[*]            el (subst (cons 10 dt) (assoc 10 el) el)
[*]            el (entmake el)
[*]            el (subst (cons 11 pt3) (assoc 11 el) el)
[*]            el (entmake el)
[*]            pt1 (polar ipt ang (* (car clst) -2))
[*]            pt3 (polar dt ang (* (car clst) -2))
[*]            el (subst (cons 10 pt1) (assoc 10 el) el)
[*]            el (subst (cons 11 pt3) (assoc 11 el) el)
[*]            el (entmake el)
[*]      )
[*]       (progn
[*]      (if (> (car (setq dt (gtl pt1 pt2))) 0.0)
[*]          (setq ipt (polar pt1 ang (cadr dt))
[*]                el (subst (cons 10 pt1) (assoc 10 el) el)
[*]                el (subst (cons 11 ipt) (assoc 11 el) el)
[*]                el (entmake el) pt1 (polar pt1 ang (car dt))
[*]      ))
[*]      (if (> (car (setq dt (gtl pt3 pt4))) 0.0)
[*]          (setq ipt (polar pt3 ang (cadr dt))
[*]                el (subst (cons 10 pt3) (assoc 10 el) el)
[*]                el (subst (cons 11 ipt) (assoc 11 el) el)
[*]                el (entmake el) pt3 (polar pt3 ang (car dt))
[*]      ))
[*]       )) ;;;end of if <
[*]      )
[*]   )   ;;; end cond
[*]    )    ;;; end while
[*]    (setq el (subst (cons 10 pt1) (assoc 10 el) el)
[*]          el (subst (cons 11 pt2) (assoc 11 el) el)
[*]          el (entmake el)
[*]          el (subst (cons 10 pt3) (assoc 10 el) el)
[*]          el (subst (cons 11 pt4) (assoc 11 el) el)
[*]          el (entmake el)
[*]    )
[*]    (if (/= t1 2)
[*]       (setq el (subst (cons 10 pt2) (assoc 10 el) el)
[*]             el (subst (cons 11 pt4) (assoc 11 el) el)
[*]             el (entmake el) t1 1
[*]    ))
[*]    )    ;; end if plst progn
[*]    (setq el (subst (cons 10 pt1) (assoc 10 el) el)
[*]          el (subst (cons 11 pt3) (assoc 11 el) el)
[*]          el (entmake el)
[*]          el (subst (cons 11 pt2) (assoc 11 el) el)
[*]          el (entmake el)
[*]          el (subst (cons 10 pt4) (assoc 10 el) el)
[*]          el (entmake el)
[*]          el (subst (cons 11 pt3) (assoc 11 el) el)
[*]          el (entmake el)
[*]    )
[*]   )    ;;; end if plst
[*])    ;;;End defun dbl
[*]
[*];;;; Get half width
[*](defun gthw (sn / w1)
[*] (setq w1 (cdr (assoc -3 (entget sn (list "AP_"))))
[*]       w1 (if w1 (cdr (assoc 1040 (cdar w1))) 240)
[*]       w1 (/ w1 2.0)
[*]))
[*]
[*](defun c:dbl   () (csdbl))
[*](princ "\n\t\t Copyright by 陈松 -- 南昌 (c) 1996.9.22")
[*](princ "\n\t\tC:CSDBL 已经加载. 键入 DBL 执行命令.")
[*](princ)
[*]

foolishzy 发表于 2023-6-7 09:21:12

楼主23行写的有点问题。(defun myerr (s)
(if (/= s "Function cancelled")
    (princ (strcat "\nError: " s)))
(if _oc (setvar "cmdecho" _oc))
(setq *error* olderr)
(princ)
)

(if wid nil (setq wid 240.0))
(defun CSDBL(/ ss _oc ssl yn llay tllay)
(setq _oc (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq olderr *error* *error* myerr)
(setq llay (getvar "clayer"))
(command "undo" "group")
(graphscr)
(setq ss0 (ssget '((0 . "LINE"))) cont 0)
(if ss0
    (progn
      (setq ssl (sslength ss0))
      (initget "Yes No")
      (setq yn (getkword "是否改变变双后线的图层<Y>: "))
      (if (or (= yn "")(= yn "Yes")(= yn nil))
      (progn
          (setq tllay (getstring (strcat "请输入图层名<" llay ">: ")))
          (if (/= tllay "") (setq llay tllay))
      )
      )
      (setq twid (getreal (strcat "请输入变双后双线间的宽度<" (rtos wid 2) ">: ")))
      (if twid (setq wid twid))
      (setq hwid (/ wid 2.0))
      (if (> ssl 30)
      (progn
          (princ)
          (princ "\n程序正在执行中 -- 稍待...")
      )
      )
      (while (setq el (ssname ss0 cont))
       (cond ((= "LINE" (cdr (assoc 0 (entget el)))) (dbl hwid))
             (t (setq ss0 (ssdel el ss0) cont (1- cont)))
       )
       (setq cont (1+ cont))
      )
    )
    (princ "\n没有选到任何实体")
)
(command "undo" "end")
(if _oc (setvar "cmdecho" _oc))
(princ)
)

;;;Get insective point's max distance
(defun gtl (p1 p2 / p3 p4 an1 mx mn c1 ipt n )
(setq n (length clst) mx -1200000.0 mn 1200000.0 c1 0)
(repeat n      
   (setq el0 (entget (ssname ss (nth c1 clst)))
         w1 (gthw (ssname ss (nth c1 clst)))
         p3 (cdr (assoc 10 el0)) p4 (cdr (assoc 11 el0))
         an1 (angle p3 p4)
   )
   (if (setq ipt (inters p1 p2 (polar p3 (+ an1 (/ pi 2)) hwid)
                            (polar p4 (+ an1 (/ pi 2)) hwid)))
    (setq ipt (distance p1 ipt) mn (min mn ipt) mx (max mx ipt))
    (if (setq ipt (inters p1 p2 (polar p3 (+ an1 (/ pi 2)) hwid)
                            (polar p4 (+ an1 (/ pi 2)) hwid) nil))
   (if (/= (+ (distance p1 ipt) (distance ipt p2)) (distance p1 p2))
      (setq ipt (- (distance ipt p1)) mn (min mn ipt) mx (max mx ipt))
   )
   (setq mx (max 0.0 mx))
    )
   )
   (if (setq ipt (inters p1 p2 (polar p3 (- an1 (/ pi 2)) hwid)
                            (polar p4 (- an1 (/ pi 2)) hwid)))
    (setq ipt (distance p1 ipt) mn (min mn ipt) mx (max mx ipt))
    (if (setq ipt (inters p1 p2 (polar p3 (- an1 (/ pi 2)) hwid)
                        (polar p4 (- an1 (/ pi 2)) hwid) nil))
   (if (/= (+ (distance p1 ipt) (distance ipt p2)) (distance p1 p2))
      (setq ipt (- (distance ipt p1)) mn (min mn ipt) mx (max mx ipt))
   )
   (setq mx (max 0.0 mx))
    )
   )
   (setq c1 (1+ c1))
)   ;;;end repeat
(list mx mn)
)

(defun dbl(hwid / ss pt1 pt2 pt3 pt4 ipt
               n1 el0 ang c1 plst clst)
(setq el (entget el)
      pt1 (cdr (assoc 10 el)) pt2 (cdr (assoc 11 el))
      ang (angle pt1 pt2) c1 0 plst () ld (distance pt1 pt2)
      el (subst (cons 8 llay) (assoc 8 el) el)
)
(setq ss (ssdel (cdr (assoc -1 el))
   (ssget "c" (mapcar '+ '(20 20) (mapcar 'max pt1 pt2))
                (mapcar '- (mapcar 'min pt1 pt2) '(20 20))
)))
(while (setq el0 (ssname ss c1))
   (cond
    ((and (= "LINE" (cdr (assoc 0 (entget el0)))) (ssmemb el0 ss0))
      (setq dt nil el0 (entget el0)
            pt3 (cdr (assoc 10 el0)) pt4 (cdr (assoc 11 el0)))
      (if (setq ipt (inters pt1 pt2 pt3 pt4))
      (cond ((equal ipt pt1 0.1) (setq dt ld))
            ((equal ipt pt2 0.1) (setq dt 0.0))
            (t(setq dt (distance ipt pt2)))
      );end cond
      )
      (if dt
       (if (setq clst (assoc dt plst))
      (setq plst (subst (append clst (list c1)) clst plst))
      (setq plst (cons (list dt c1) plst))
      ))
    );;end of line
   );end of cond
   (setq c1 (1+ c1))
) ;end while
(setq pt1 (polar pt1 (+ ang (/ pi 2)) hwid)
      pt2 (polar pt2 (+ ang (/ pi 2)) hwid)
      pt3 (polar pt1 (- ang (/ pi 2)) (* 2 hwid))
      pt4 (polar pt2 (- ang (/ pi 2)) (* 2 hwid))
)
(if plst (progn
    (setq t1 0)
    (while (< -1.0 (setq dt (apply 'max (mapcar 'car plst))))
   (setq clst (cdr (assoc dt plst))
         plst (subst '(-1 0) (assoc dt plst) plst)
   )
   (cond
      ((= dt ld) (setq t1 1)
       (setq dt (gtl pt1 pt2) pt1 (polar pt1 ang (car dt))
             dt (gtl pt3 pt4) pt3 (polar pt3 ang (car dt)))
      )
      ((= dt 0.0)
       (if (= t1 0)
      (setq el (subst (cons 10 pt1) (assoc 10 el) el)
            el (subst (cons 11 pt3) (assoc 11 el) el)
            el (entmake el) t1 1
       ))
       (setq t1 2)
       (setq dt (gtl pt2 pt1) pt2 (polar pt2 (+ ang pi) (car dt))
             dt (gtl pt4 pt3) pt4 (polar pt4 (+ ang pi) (car dt)))
      )
      (t (if (= t1 0)
      (setq el (subst (cons 10 pt1) (assoc 10 el) el)
            el (subst (cons 11 pt3) (assoc 11 el) el)
            el (entmake el) t1 1
      ))
       (if (< (car clst) 0.0)
      (setq ipt (polar pt2 ang (+ (- dt) (car clst)))
            el (subst (cons 10 pt1) (assoc 10 el) el)
            el (subst (cons 11 ipt) (assoc 11 el) el)
            el (entmake el)
            dt (polar pt4 ang (+ (- dt) (car clst)))
            el (subst (cons 10 dt) (assoc 10 el) el)
            el (entmake el)
            el (subst (cons 11 pt3) (assoc 11 el) el)
            el (entmake el)
            pt1 (polar ipt ang (* (car clst) -2))
            pt3 (polar dt ang (* (car clst) -2))
            el (subst (cons 10 pt1) (assoc 10 el) el)
            el (subst (cons 11 pt3) (assoc 11 el) el)
            el (entmake el)
      )
       (progn
      (if (> (car (setq dt (gtl pt1 pt2))) 0.0)
          (setq ipt (polar pt1 ang (cadr dt))
                el (subst (cons 10 pt1) (assoc 10 el) el)
                el (subst (cons 11 ipt) (assoc 11 el) el)
                el (entmake el) pt1 (polar pt1 ang (car dt))
      ))
      (if (> (car (setq dt (gtl pt3 pt4))) 0.0)
          (setq ipt (polar pt3 ang (cadr dt))
                el (subst (cons 10 pt3) (assoc 10 el) el)
                el (subst (cons 11 ipt) (assoc 11 el) el)
                el (entmake el) pt3 (polar pt3 ang (car dt))
      ))
       )) ;;;end of if <
      )
   )   ;;; end cond
    )    ;;; end while
    (setq el (subst (cons 10 pt1) (assoc 10 el) el)
          el (subst (cons 11 pt2) (assoc 11 el) el)
          el (entmake el)
          el (subst (cons 10 pt3) (assoc 10 el) el)
          el (subst (cons 11 pt4) (assoc 11 el) el)
          el (entmake el)
    )
    (if (/= t1 2)
       (setq el (subst (cons 10 pt2) (assoc 10 el) el)
             el (subst (cons 11 pt4) (assoc 11 el) el)
             el (entmake el) t1 1
    ))
    )    ;; end if plst progn
    (setq el (subst (cons 10 pt1) (assoc 10 el) el)
          el (subst (cons 11 pt3) (assoc 11 el) el)
          el (entmake el)
          el (subst (cons 11 pt2) (assoc 11 el) el)
          el (entmake el)
          el (subst (cons 10 pt4) (assoc 10 el) el)
          el (entmake el)
          el (subst (cons 11 pt3) (assoc 11 el) el)
          el (entmake el)
    )
   )    ;;; end if plst
)    ;;;End defun dbl

;;;; Get half width
(defun gthw (sn / w1)
(setq w1 (cdr (assoc -3 (entget sn (list "AP_"))))
       w1 (if w1 (cdr (assoc 1040 (cdar w1))) 240)
       w1 (/ w1 2.0)
))

(defun c:dbl   () (csdbl))
(princ "\n\t\t Copyright by 陈松 -- 南昌 (c) 1996.9.22")
(princ "\n\t\tC:CSDBL 已经加载. 键入 DBL 执行命令.")
(princ)

aggdqty 发表于 2023-6-7 09:31:22

foolishzy 发表于 2023-6-7 09:21
楼主23行写的有点问题。

可以了，谢谢   
页: [1]
查看完整版本: 提问-单线变双线图层不能设置