求选线，则该线图层上的线均改为实线

品茗新秀

求选线，则该线图层上的线均改为实线

namezg

(defun c:ZG_ChangeLinetype (/ en lay ss)
        (vl-load-com)
        (setvar "cmdecho" 0)
        (command "_undo" "be")
        (if (and (setq en (car (entsel "\n请选择源线型对象：")))
                        (setq lay (cdr (assoc 8 (entget en))))
                        (princ "\n请选择目标图层对象：")
                        (setq ss (ssget (list (cons 8 lay ))))
                )
                (command "chprop" ss "" "lt" "Continuous" "");(command "change" ss "" "p" "lt" "Continuous" "")
        )
        (command "_undo" "e")
        (setvar "cmdecho" 1)
        (princ)
)

lsjj

問題很簡單,但大夥似乎回覆的意願不高
可能的原因是樓主求助帖太多了,常要其他回覆的人無中生有,也違反本版塊的宗旨
建議樓主下回提問時,可以先提供自己試著寫的程序
先自助才有人助,你會發現這裡有很多善心人士的

品茗新秀

lsjj 发表于 2014-3-29 17:17
問題很簡單,但大夥似乎回覆的意願不高
可能的原因是樓主求助帖太多了,常要其他回覆的人無中生有,也違反本版 ...

这个确实有难度，我试了几次，都没成功，我知道，点选线，取得图层，然后按图层框选图层，问题是有的线有
线型，有的线没线型，默认线型是什么，是这个不懂，因为我是初学，实在基础知识太差，求高手指点一二

llsheng_73

(defun c:tt(/ m s a la)
  (while(null(setq s(car(entsel"点选样本对象")))))
  (entmod(subst'(70 . 0)(assoc 70(setq la(entget(TBLOBJNAME"layer"(cdr(assoc 8(entget s)))))))la))
  (setq s(ssget"X"(list(assoc 8(entget s))))m 0)
  (repeat(sslength s)
    (entmod(setq a(entget(ssname s m))m(1+ m)a(append(vl-remove(assoc 6 a)a)'((6 . "Continuous")))))
    )
  (entmod la)
  )

虽然没用COMMAND调用命令，但是一个个图元的改也比较头痛
可能应该可以用VLA的方法去改一个选择集对象的线型吧,由于只修改一个项，应该VLA的方法可以比entmod图元更高效

品茗新秀

llsheng_73 发表于 2014-3-29 22:07
(defun c:tt(/ m s a la)
  (while(null(setq s(car(entsel"点选样本对象")))))
  (entmod(subst'(70 . 0 ...

我改了一下，但程序执行后，出现   错误: 参数类型错误: lentityp nil
请帮看一下，程序哪里出现了问题
(defun c:tt( / a i la m s ss1)

(setq SS1 (ssget ":L") I 0)
  (WHILE  (sslength SS1)
  (SETQ s (SSNAME   SS1 I))
(if (>(sslength SS1)0)
(progn
  (entmod(subst'(70 . 0)(assoc 70(setq la(entget(Tblobjname"layer"(cdr(assoc 8(entget s)))))))la))
  (setq s(ssget"X"(list(assoc 8(entget s))))m 0)
  (repeat(sslength s)
    (entmod(setq a(entget(ssname s m))m(1+ m)a(append(vl-remove(assoc 6 a)a)'((6 . "Continuous")))))
    )
  (entmod la)
  ))

llsheng_73

你这里有几个问题，第一ss1里边可能存在多个图元在同一图层，会导致某些图层上的图元会进行反复修改
第二先进入循环再判断这是不合适的，如果在(setq SS1 (ssget ":L") I 0)的时候直接右键，它下一句(SETQ s (SSNAME   SS1 I))就会出错，后边的判断不会起作用，反之，这个判断它也不必要了
另外，由于用了":L"方式进行选择，锁定图层是不会被选中的，所以对于图层的处理是没有心要的
要实现你多选进行按图层修改的目的，应该先得到那个选择集所涉及到的图层列表，再一个个图层进行处理
比如
(defun c:tt1( / a i la lys m s ss1)
  (setq SS1 (ssget ) lys nil I 0)
  (if ss1(repeat(sslength ss1)
           (setq la(cdr(assoc 8(entget(ssname ss1 i))))
             lys(if(member la lys)lys(cons la lys))
                 i(1+ i))))
(foreach x lys
   (entmod(subst'(70 . 0)(assoc 70(setq la(entget(Tblobjname"layer" x))))la))
   (setq s(ssget"X"(list(cons 8 x)))m 0)
   (repeat(sslength s)
     (entmod(setq a(entget(ssname s m))m(1+ m)a(append(vl-remove(assoc 6 a)a)'((6 . "Continuous")))))
     )
   (entmod la)
   )
    (princ)
   )
另外，对于组码值是字串的情况，它可以不组成表而用字串把它们接起来,比如(ssget"X"'((8 . "A*，图层1，GCD,DH")))这是可以的，但是由于你一次多选很多图元，一是它们可能处于不同的图层，二是这些图层可能有的被锁定而导致这些图层不可编辑，对锁定图层的图元进行ENTMOD会夫效，所以还是需要得到图层表，以便对它们进行解锁，当然，最后还得恢复它们，这就需要保存图层数据
比如
(defun c:tt2( / a i la lys m s ss1)
  (setq SS1 (ssget ) lys nil la""I 0)
  (if ss1(repeat(sslength ss1)
           (setq la(cdr(assoc 8(entget(ssname ss1 i))))
             lys(if(member la lys)lys(cons la lys))
                 i(1+ i))))
  (foreach x lys
    (setq la(strcat la","x)a(entget(Tblobjname"layer" x))
          lys(subst a x lys))
    (entmod(subst'(70 . 0)(assoc 70 a)a)))
  (setq s(ssget"X"(list(cons 8 la)))m 0)
   (repeat(sslength s)
     (entmod(setq a(entget(ssname s m))m(1+ m)a(append(vl-remove(assoc 6 a)a)'((6 . "Continuous")))))
     )
   (mapcar'entmod lys)
   (princ)
   )

建议用TT2的方式，只需要把循环修改图元那部分换成VLA的方法来实现的话，应该也会很高效的,毕竟图层再多也是有限的，而图元可能会有很多，如果没有高效的VLA方法的话，可能也只有用COMMAND调用CAD命令来修改才会快些了

namezg

关于图层锁定的问题很简单
可以先启用图层修改跟踪，然后解锁所有图层，最后恢复图层的原始状态即可。可用下面二种方法。
(defun c:ZG_ChangeLinetype1 (/ en lay ss)
        (vl-load-com)
        (setvar "cmdecho" 0)
        (command "_undo" "be")
        (command "layerpmode" "on")
        (command "-layer" "u" "*" "")
        (if (and (setq en (car (entsel "\n请选择源线型对象：")))
                        (setq lay (cdr (assoc 8 (entget en))))
                        (princ "\n请选择目标图层对象：")
                        (setq ss (ssget (list (cons 8 lay ))))
                )
                (command "chprop" ss "" "lt" "Continuous" "");(command "change" ss "" "p" "lt" "Continuous" "")
        )
        (command "layerp")
        (command "_undo" "e")
        (setvar "cmdecho" 1)
        (princ)
)

(defun c:ZG_ChangeLinetype2 (/ en lay ss)
        (vl-load-com)
        (setvar "cmdecho" 0)
        (command "_undo" "be")
        (if (not (acet-layerp-mode))
                (acet-layerp-mode T)
        )
        (acet-layerp-mark T)
        (command "-layer" "u" "*" "")
        (if (and (setq en (car (entsel "\n请选择源线型对象：")))
                        (setq lay (cdr (assoc 8 (entget en))))
                        (princ "\n请选择目标图层对象：")
                        (setq ss (ssget (list (cons 8 lay ))))
                )
                (command "chprop" ss "" "lt" "Continuous" "");(command "change" ss "" "p" "lt" "Continuous" "")
        )
        (acet-layerp-mark nil)
        (command "_undo" "e")
        (setvar "cmdecho" 1)
        (princ)
)