【e派】工具箱函数再揭秘及应用实例

Dani1988

2015最后一天来顶一下，2016大家好运，哈哈哈

杜阳

根据院长大人的函数
;; xyp-mkLaCo 建立图层信息 (xyp-mkLaCo la co)增加了线性
可以使用 调试时总是提示错误：TT 未知命令“TT”。按 F1 查看帮助。
;; xyp-mkLaCo1 建立图层信息 (xyp-mkLaCo1 la co lt)
(defun xyp-mkLaCo1 (la co lt)
  (if (= (tblsearch "layer" la) nil)
    (if        (= (type co) 'INT)
      (command "-layer" "m" la "c" co "" "")
      (command "-layer" "m" la "c" "t" co "" "")
    )

    (command "-layer" "t" la "")
  )
  (command "-layer" "l" lt la "" "")
  (setvar 'clayer la)
  (setvar 'cecolor "BYLAYER")
  (setvar 'celtype "ByLayer")
  (setvar 'celweight -1)
  (princ)
)
(defun c:tt()
(xyp-mkLaCo1 "3" 2 "x5")
)
不知道为什么   请院长给予指点  谢谢了

sicky111

杜阳 发表于 2016-1-25 11:07
根据院长大人的函数
;; xyp-mkLaCo 建立图层信息 (xyp-mkLaCo la co)增加了线性
可以使用 调试时总是提示 ...

你的线型管理器有这个“x5”吗？

sicky111

;; xyp-mkLaCo 建立图层信息 (xyp-mkLaCo la co)增加了线性
;; xyp-mkLaCo1 建立图层信息 (xyp-mkLaCo1 la co lt)
(defun xyp-mkLaCo1 (la co lt)
   (if (= (tblsearch "layer" la) nil)
     (if        (= (type co) 'INT)
       (command "-layer" "m" la "c" co "" "")
       (command "-layer" "m" la "c" "t" co "" "")
     )

     (command "-layer" "t" la "")
   )
   (command "-layer" "l" lt la "")
   (setvar 'clayer la)
   (setvar 'cecolor "BYLAYER")
   (setvar 'celtype "ByLayer")
   (setvar 'celweight -1)
   (princ)
)

前生

(defun fh-lay (lay c LNAME)                ;LNAMeÎaÏßDí
(setq        ltps (vla-get-linetypes
               (vla-get-activedocument (vlax-get-acad-object))
             )
  )
  (setq        ltp (vl-catch-all-apply
              'vla-load
              (list ltps lname "acadiso.lin")
            )
  )
  (if (vl-catch-all-error-p ltp)
    (princ)
    (princ)
  )
  (if (null (tblobjname "LAYER" lay))
    (progn
      (vla-add
        (vla-get-layers
          (vla-get-activedocument (vlax-get-acad-object))
        )
        lay                                ; "6";;2ãÃû
      )
      (vla-put-color
        (vla-item (vla-get-layers
                    (vla-get-activedocument (vlax-get-acad-object))
                  )
                  lay                        ;"0";;2ãÃû
        )
        c                                ;6;;ÑÕé«
      )
      (vla-put-LINETYPE
        (vla-item (vla-get-layers
                    (vla-get-activedocument (vlax-get-acad-object))
                  )
                  lay                        ;"0";;2ãÃû
        )
        LNAME                                ;6;;ÏßDí
      )
    )
    (progn                                ;òÑÔú
      (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
            lays  (vla-get-Layers acDoc)
      )
      (setq vvlay (vla-Item lays lay))
      (if (= (vla-get-Freeze vvlay) :vlax-true)
        (vla-put-Freeze vvlay :vlax-false) ;½a¶3
      )
      (if (= (vla-get-Lock vvlay) :vlax-true)
        (vla-put-Lock vvlay :vlax-false) ;½aËø
      )
      (if (= (vla-get-LayerOn vvlay) :vlax-false)
        (vla-put-LayerOn vvlay :vlax-true) ;¿é¼û
      )
      (vla-put-ActiveLayer acDoc vvlay)        ;éèÎaμ±Ç°2ã
      (PROGN
        (vla-put-color
          (vla-item (vla-get-layers
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
                    lay                        ;"0";;2ãÃû
          )
          c                                ;6;;ÑÕé«
        )
        (vla-put-LINETYPE
          (vla-item (vla-get-layers
                      (vla-get-activedocument (vlax-get-acad-object))
                    )
                    lay                        ;"0";;2ãÃû
          )
          LNAME                                ;6;;ÑÕé«
        )
      )
    )
  )
  (setvar "clayer" lay)
  (princ)
)

前生

网上的函数，做个子函数，还可以。

杜阳

sicky111 发表于 2016-1-25 11:17
你的线型管理器有这个“x5”吗？

有这个线性啊   谢谢老师指导  

杜阳

前生 发表于 2016-1-25 12:38
网上的函数，做个子函数，还可以。

谢谢老师指导    谢谢

clh521

cable2004 发表于 2012-8-3 23:08
;;;------------------------ CMDLA0 -------------------------
;;;                    保存用户系统变量 ...

你有这个(SETBL)函数吗，想用CMDLA0却发现少了SETBL函数

知行ooo李肖坪

谢谢分享…………