判断线型的问题

Free-Lancer · 发表于 2015-1-9 19:30:50

lucas3 发表于 2015-1-9 18:20
大师，重新使用28楼的程序，并将29楼处的替换掉，问题还存在，还是参数太少，点取消还是要选择对象

(defun c:tt (/ ss dcl fn id klst)
(defun _make
(e / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln1 ln2)
(setq lst '((2.5 "M3" 0.06 1.5)
(3.3 "M4" 0.08 1.5)
(4.2 "M5" 0.1 2.5)
(5.0 "M6" 0.12 3.0)
(6.8 "M8" 0.16 4.0)
(8.5 "M10" 0.2 5.0)
(10.5 "M12" 0.24 6.0)
(12.0 "M14" 0.28 7.0)
(14.0 "M16" 0.32 8.0)
(15.5 "M18" 0.36 9.0)
(17.5 "M20" 0.4 10.0)
)
)
(setq r (vlax-get e 'radius)
pcen (vlax-get e 'center)
)
(mapcar 'set '(str xk mr) (cdr (assoc r lst)))
(setq cel (if (eq (setq lt (vlax-get e "linetype"))
"ByLayer"
)
(vlax-get
(vla-item (fy:aclayers) (vlax-get e "layer"))
"linetype"
)
lt
)
)
(setq dis (* r 1.1)
p1 (polar pcen 0. dis)
p2 (polar pcen _pi2 dis)
p3 (polar pcen pi dis)
p4 (polar pcen (- _pi2) dis)
)
(if (member "isBlock" slst)
(setq space (vla-add (fy:acblocks) (vlax-3d-point pcen) "*U"))
(setq space (fy:acms))
)
(setq cir (vlax-invoke space 'addcircle pcen r)
arc (vlax-invoke space 'addarc pcen mr 4.71239 3.14159)
ln1 (vlax-invoke space 'addline p1 p3)
ln2 (vlax-invoke space 'addline p2 p4)
)
(mapcar '(lambda (x)
(vlax-put (car x) 'layer "screw")
(vlax-put (car x) 'color (cadr x))
(vlax-put (car x) "linetype" (caddr x))
(vlax-put (car x) "linetypescale" xk)
)
(list (list cir 33 cel)
(list arc 3 cel)
(list ln1 1 "center")
(list ln2 1 "center")
)
)
(if (member "isText" slst)
(progn
(setq txt (vlax-invoke space 'AddText str pcen (* mr 0.4)))
(vla-put-alignment txt acAlignmentTopCenter)
(vla-put-textalignmentpoint
txt
(vlax-3d-point (polar pcen (- _pi2) (* mr 0.17)))
)
)
)
(if (member "isBlock" slst)
(vlax-invoke
(fy:acspace)
'insertblock
pcen
(vla-get-name space)
1.
1.
1.
0.
)
)
)
(if (not slst)
(setq slst '("isErased" "isText" "isBlock"))
)
(setq dcl '("screw:dialog{"
"label = \"参数设置\";"
" :toggle{ key = \"isErased\"; label = \"删除原线条\";}"
" :toggle { key = \"isText\"; label = \"显示文字\";}"
" :toggle { key = \"isBlock\"; label = \"生成块\";}"
" ok_cancel;"
"}"
)
klst '("isErased" "isText" "isBlock")
fn (xd::dcl:make dcl)
id (xd::dcl:load fn "screw")
)
(xd::Dcl:toggleaction
klst ;_key 列表
'slst ;_记录勾选项的变量，做全局变量时下次有默认值
nil
) ;_设置 Toggle 并定义 Action
(fy:begin)
(if (and (= (xd::dcl:start id fn)
1
)
(setq ss (ssget '((0 . "circle")
(-4 . "<or")
(40 . 2.5)
(40 . 3.3)
(40 . 4.2)
(40 . 5.0)
(40 . 6.8)
(40 . 8.5)
(40 . 10.5)
(40 . 12.0)
(40 . 14.0)
(40 . 15.5)
(40 . 17.5)
(-4 . "or>")
)
)
)
)
(progn
(if (not (tblsearch "style" "txt"))
(command ".style" "txt" "txt.shx,gbcbig.shx"
0.0 1.0 0.0 "n"
"n" "n"
)
)
(if (not (tblsearch "ltype" "hidden"))
(vla-load (fy:acltypes) "hidden" "acadiso.lin")
)
(if (not (tblsearch "ltype" "center"))
(vla-load (fy:acltypes) "center" "acadiso.lin")
)
(if (not (tblsearch "layer" "screw"))
(vla-add (fy:aclayers) "screw")
)
(mapcar '(lambda (x) (_make x)) (fy:cset->objs))
(if (member "isErased" slst)
(command ".erase" ss "")
)
)
)
(princ)
)
;|
设置 toggle 控件
_$klst ---- 控件名或控件名列表
_$symL ---- 值为控件名或控件名列表的变量名
含有该控件的为勾选，否则不选
|;
(defun XD::DCL:ToggleInit (_$klst _$symL)
(if (listp _$klst)
(mapcar '(lambda (x)
(if (and _$symL (member x (vl-symbol-value _$symL)))
(set_tile x "1")
(set_tile x "0")
)
)
_$klst
)
(set_tile _$klst
(if (and _$syml (vl-symbol-value _$symL))
"1"
"0"
)
)
)
)
(defun XD::DCL:ToggleAction
(_$klst _$symL _$callbackL / _sToggleAction)
(defun _sToggleAction (_$key _$symL _$callbackL)
(action_tile
_$key
(strcat "(if (= $value \"0\")"
"(setq "
(vl-symbol-name _$symL)
"(vl-remove $key "
(vl-symbol-name _$symL)
"))(if (not (member $key "
(vl-symbol-name _$symL)
"))(setq "
(vl-symbol-name _$symL)
"(cons $key "
(vl-symbol-name _$symL)
"))))"
(if _$callbackL
(strcat "(" _$callbackL ")")
""
)
)
)
)
(XD::DCL:ToggleInit _$klst _$symL)
(if (listp _$klst)
(while _$klst
(_sToggleAction (car _$klst) _$symL (car _$callbackL))
(setq _$klst (cdr _$klst)
_$callbackL (cdr _$callbackL)
)
)
(_sToggleAction _$klst _$symL _$callbackL)
)
)
;;将DCL表写出文件
(defun XD::DCL:Make (lst / flname ofile)
(setq FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl"))
oFile (open FlName "w")
)
(foreach fStream lst (write-line fStream oFile)) ;写入文件
(close oFile) ;_关闭文档
flname
)
;;加载 DCL 文件
(defun XD::DCL:Load (flname na / dcl_id)
(setq dcl_id (load_dialog FlName))
(if (not (new_dialog na dcl_id ""))
(progn (alert "对话框加载失败!") (exit))
)
dcl_id
)
;;用于不返回的 DCL
(defun XD::Dcl:Start (id flname / dg)
(setq dg (start_dialog))
(unload_dialog id) ;_卸载对话框
(vl-file-delete FlName) ;_删除DCL文件
dg
)

(defun c:tt (/ ss dcl fn id klst) 
  (defun _make 
         (e / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln1 ln2) 
    (setq lst '((2.5 "M3" 0.06 1.5) 
                (3.3 "M4" 0.08 1.5) 
                (4.2 "M5" 0.1 2.5) 
                (5.0 "M6" 0.12 3.0) 
                (6.8 "M8" 0.16 4.0) 
                (8.5 "M10" 0.2 5.0) 
                (10.5 "M12" 0.24 6.0) 
                (12.0 "M14" 0.28 7.0) 
                (14.0 "M16" 0.32 8.0) 
                (15.5 "M18" 0.36 9.0) 
                (17.5 "M20" 0.4 10.0) 
               ) 
    ) 
    (setq r    (vlax-get e 'radius) 
          pcen (vlax-get e 'center) 
    ) 
    (mapcar 'set '(str xk mr) (cdr (assoc r lst))) 
    (setq cel (if (eq (setq lt (vlax-get e "linetype")) 
                      "ByLayer" 
                  ) 
                (vlax-get 
                  (vla-item (fy:aclayers) (vlax-get e "layer")) 
                  "linetype" 
                ) 
                lt 
              ) 
    ) 
    (setq dis (* r 1.1) 
          p1  (polar pcen 0. dis) 
          p2  (polar pcen _pi2 dis) 
          p3  (polar pcen pi dis) 
          p4  (polar pcen (- _pi2) dis) 
    ) 
    (if        (member "isBlock" slst) 
      (setq space (vla-add (fy:acblocks) (vlax-3d-point pcen) "*U")) 
      (setq space (fy:acms)) 
    ) 
    (setq cir (vlax-invoke space 'addcircle pcen r) 
          arc (vlax-invoke space 'addarc pcen mr 4.71239 3.14159) 
          ln1 (vlax-invoke space 'addline p1 p3) 
          ln2 (vlax-invoke space 'addline p2 p4) 
    ) 
    (mapcar '(lambda (x) 
               (vlax-put (car x) 'layer "screw") 
               (vlax-put (car x) 'color (cadr x)) 
               (vlax-put (car x) "linetype" (caddr x)) 
               (vlax-put (car x) "linetypescale" xk) 
             ) 
            (list (list cir 33 cel) 
                  (list arc 3 cel) 
                  (list ln1 1 "center") 
                  (list ln2 1 "center") 
            ) 
    ) 
    (if        (member "isText" slst) 
      (progn 
        (setq txt (vlax-invoke space 'AddText str pcen (* mr 0.4))) 
        (vla-put-alignment txt acAlignmentTopCenter) 
        (vla-put-textalignmentpoint 
          txt 
          (vlax-3d-point (polar pcen (- _pi2) (* mr 0.17))) 
        ) 
      ) 
    ) 
    (if        (member "isBlock" slst) 
      (vlax-invoke 
        (fy:acspace) 
        'insertblock 
        pcen 
        (vla-get-name space) 
        1. 
        1. 
        1. 
        0. 
      ) 
    ) 
  ) 
  (if (not slst) 
    (setq slst '("isErased" "isText" "isBlock")) 
  ) 
  (setq        dcl  '("screw:dialog{" 
               "label = \"参数设置\";" 
               " :toggle{ key = \"isErased\"; label = \"删除原线条\";}" 
               " :toggle { key = \"isText\"; label = \"显示文字\";}" 
               " :toggle { key = \"isBlock\"; label = \"生成块\";}" 
               " ok_cancel;" 
               "}" 
              ) 
        klst '("isErased" "isText" "isBlock") 
        fn   (xd::dcl:make dcl) 
        id   (xd::dcl:load fn "screw") 
  ) 
  (xd::Dcl:toggleaction 
    klst ;_key 列表 
    'slst ;_记录 勾选项 的变量，做全局变量时下次有默认值 
    nil 
  ) ;_设置 Toggle  并定义 Action 
  (fy:begin) 
  (if (and (= (xd::dcl:start id fn) 
              1 
           ) 
           (setq ss (ssget '((0 . "circle") 
                             (-4 . "<or") 
                             (40 . 2.5) 
                             (40 . 3.3) 
                             (40 . 4.2) 
                             (40 . 5.0) 
                             (40 . 6.8) 
                             (40 . 8.5) 
                             (40 . 10.5) 
                             (40 . 12.0) 
                             (40 . 14.0) 
                             (40 . 15.5) 
                             (40 . 17.5) 
                             (-4 . "or>") 
                            ) 
                    ) 
           ) 
      ) 
    (progn 
      (if (not (tblsearch "style" "txt")) 
        (command ".style"    "txt"         "txt.shx,gbcbig.shx" 
                 0.0             1.0         0.0             "n" 
                 "n"             "n" 
                ) 
      ) 
      (if (not (tblsearch "ltype" "hidden")) 
        (vla-load (fy:acltypes) "hidden" "acadiso.lin") 
      ) 
      (if (not (tblsearch "ltype" "center")) 
        (vla-load (fy:acltypes) "center" "acadiso.lin") 
      ) 
      (if (not (tblsearch "layer" "screw")) 
        (vla-add (fy:aclayers) "screw") 
      ) 
      (mapcar '(lambda (x) (_make x)) (fy:cset->objs)) 
      (if (member "isErased" slst) 
        (command ".erase" ss "") 
      ) 
    ) 
  ) 
  (princ) 
) 
;| 
设置 toggle 控件 
_$klst ---- 控件名或控件名列表 
_$symL ---- 值为控件名或控件名列表的变量名 
            含有该控件的为勾选，否则不选 
|; 
(defun XD::DCL:ToggleInit (_$klst _$symL) 
  (if (listp _$klst) 
    (mapcar '(lambda (x) 
               (if (and _$symL (member x (vl-symbol-value _$symL))) 
                 (set_tile x "1") 
                 (set_tile x "0") 
               ) 
             ) 
            _$klst 
    ) 
    (set_tile _$klst 
              (if (and _$syml (vl-symbol-value _$symL)) 
                "1" 
                "0" 
              ) 
    ) 
  ) 
) 
(defun XD::DCL:ToggleAction 
       (_$klst _$symL _$callbackL / _sToggleAction) 
  (defun _sToggleAction        (_$key _$symL _$callbackL) 
    (action_tile 
      _$key 
      (strcat "(if (= $value \"0\")" 
              "(setq " 
              (vl-symbol-name _$symL) 
              "(vl-remove $key " 
              (vl-symbol-name _$symL) 
              "))(if (not (member $key " 
              (vl-symbol-name _$symL) 
              "))(setq " 
              (vl-symbol-name _$symL) 
              "(cons $key " 
              (vl-symbol-name _$symL) 
              "))))" 
              (if _$callbackL 
                (strcat "(" _$callbackL ")") 
                "" 
              ) 
      ) 
    ) 
  ) 
  (XD::DCL:ToggleInit _$klst _$symL) 
  (if (listp _$klst) 
    (while _$klst 
      (_sToggleAction (car _$klst) _$symL (car _$callbackL)) 
      (setq _$klst        (cdr _$klst) 
            _$callbackL        (cdr _$callbackL) 
      ) 
    ) 
    (_sToggleAction _$klst _$symL _$callbackL) 
  ) 
) 
;;将DCL表写出文件 
(defun XD::DCL:Make (lst / flname ofile) 
  (setq        FlName (vl-filename-mktemp (strcat "FYDCL" ".dcl")) 
        oFile  (open FlName "w") 
  ) 
  (foreach fStream lst (write-line fStream oFile)) ;写入文件 
  (close oFile) ;_关闭文档 
  flname 
) 
 
;;加载 DCL 文件 
(defun XD::DCL:Load (flname na / dcl_id) 
  (setq dcl_id (load_dialog FlName)) 
  (if (not (new_dialog na dcl_id "")) 
    (progn (alert "对话框加载失败!") (exit)) 
  ) 
  dcl_id 
) 
;;用于不返回的 DCL 
(defun XD::Dcl:Start (id flname / dg) 
  (setq dg (start_dialog)) 
  (unload_dialog id) ;_卸载对话框 
  (vl-file-delete FlName) ;_删除DCL文件 
  dg 
)

lucas3 · 发表于 2015-1-9 20:21:27

本帖最后由 lucas3 于 2015-1-20 16:17 编辑

Free-Lancer 发表于 2015-1-9 19:30

大师，刚才说的问题解决了，谢谢！

wangxf888 · 发表于 2016-5-24 17:37:38

要学的东西太多了发蒙

账号		自动登录	找回密码
密码			立即注册

[已解决] 判断线型的问题

点评

评分