判断线型的问题

lucas3 · 发表于 2014-12-11 10:10:52

本帖最后由 lucas3 于 2014-12-11 10:13 编辑

一个根据圆生成螺纹的代码，程序中判断圆的线型是HIDDEN ，生成的螺纹线也就是HIDDEN（话称不可见螺纹）
但有时，有些圆的图层已经定义过线型是HIDDEN，实际就是Bylayer ,这样，程序就不能识别为HIDDEN线型了，生成的螺纹线就是continuous 线型的（可见螺纹），所以程序不能仅仅判断是否HIDDEN线型，如果是Bylayer ，还要看它的图层中定义的线型，如果图层中定义的线型是HIDDEN，生成的螺纹线也应该是HIDDEN

不知以上的解释，大师能不能看懂？希望大师帮忙解决一下，谢谢！！！

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝分割线

;;http://bbs.mjtd.com/thread-100947-1-1.html
(defun c:sww()
;----系统变量备份----
(setvar "cmdecho" 0);_关闭命令提示
(command "undo" "be")
(setq osmode_bak (getvar "osmode"));_记录捕捉
(setvar "osmode" 0);_关闭捕捉
(setq clayer_bak (getvar "clayer"));_记录当前图层
(setq cecolor_bak (getvar "cecolor"));_记录当前颜色
(setq celtype_bak (getvar "celtype"));_记录当前线型
(setq textstyle_bak (getvar "textstyle"));_记录当前文字样式
(setq chksty (tblsearch "style" "TXT"))
(if (= chksty nil)
(entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") (cons 2 "TXT")
'(70 . 0) (cons 40 1) (cons 41 1) '(3 . "txt.shx") '(4 . "gbcbig.shx")
)
)
)
(setq chklty (tblsearch "LTYPE" "CENTER"))
(if (= chklty nil)
(entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLinetypeTableRecord")
(cons 2 "CENTER") '(3 . "Center ____ _ ____ _ ____ _ ____ _ ____ _ ____")
'(70 . 0) '(73 . 2) '(40 . 15.0) '(49 . 10.0) '(74 . 0) '(49 . -5.0) '(74 . 0)
)
)
)
(setq ss (ssget '((0 . "CIRCLE")))
i 0)
(repeat (sslength ss)
(setq ename (ssname ss i)
dat (entget ename)
pt (usdxf 10 dat)
r (dxf 40 dat)
cel (dxf 6 dat)
D (* R 2)
)
(if (or (= cel "DASHED") (= cel "HIDDEN"))
(setq cel "HIDDEN")
(setq cel "Continuous")
)
(cond ((= d 2.5)
(setq text "M3")
(setq xk 0.06)
(setq mr 1.5)
(makent)
)
((= d 3.3)
(setq text "M4")
(setq xk 0.08)
(setq mr 2)
(makent)
)
((= d 4.2)
(setq text "M5")
(setq xk 0.1)
(setq mr 2.5)
(makent)
)
((= d 5)
(setq text "M6")
(setq xk 0.12)
(setq mr 3)
(makent)
)
((= d 6.8)
(setq text "M8")
(setq xk 0.16)
(setq mr 4)
(makent)
)
((= d 8.5)
(setq text "M10")
(setq xk 0.2)
(setq mr 5)
(makent)
)
((= d 10.5)
(setq text "M12")
(setq xk 0.24)
(setq mr 6)
(makent)
)
((= d 12)
(setq text "M14")
(setq xk 0.28)
(setq mr 7)
(makent)
)
((= d 14)
(setq text "M16")
(setq xk 0.32)
(setq mr 8)
(makent)
)
((= d 15.5)
(setq text "M18")
(setq xk 0.36)
(setq mr 9)
(makent)
)
((= d 17.5)
(setq text "M20")
(setq xk 0.4)
(setq mr 10)
(makent)
)
)
(setq i (1+ i))
)
;----系统变量还原----
(setvar "osmode" osmode_bak);_还原捕捉
(setvar "clayer" clayer_bak);_还原图层
(setvar "cecolor" cecolor_bak);_还原颜色
(setvar "celtype" celtype_bak);_还原线型
(setvar "textstyle" textstyle_bak);_还原文字样式
(command "undo" "e")
(setvar "cmdecho" 1);_打开命令提示
(princ);_关闭程序返回值
)
(defun makent ()
;;;计算点
(setq dist (* mr 1.1))
(setq texth (* mr 0.4))
(setq pt1 (polar pt 0 dist))
(setq pt2 (polar pt (* PI 0.5) dist))
(setq pt3 (polar pt pi dist))
(setq pt4 (polar pt (* 1.5 pi) dist))
(setq tept1 (polar pt pi (* mr 2 0.17)))
(setq textpt (polar tept1 (* 1.5 pi) (* mr 2 0.25)))
;生成圆
(entmake (list (cons 0 "CIRCLE")
(cons 67 0)
(CONS 62 33)
(cons 8 "screw")
(cons 6 cel)
(cons 48 xk)
(cons 10 pt)
(cons 40 r)
)
)
(setq en1 (entlast))
;生成中心线
(entmake (list (cons 0 "LINE")
(cons 8 "screw")
(CONS 62 1)
(cons 6 "CENTER")
(cons 48 xk)
(cons 10 pt1)
(cons 11 pt3)
)
)
(setq en2 (entlast))
;生成中心线
(entmake (list (cons 0 "LINE")
(cons 8 "screw")
(CONS 62 1)
(cons 6 "CENTER")
(cons 48 xk)
(cons 10 pt2)
(cons 11 pt4)
)
)
(setq en3 (entlast))
;生成圆弧
(entmake (list (cons 0 "ARC")
(cons 8 "screw")
(CONS 62 92)
(cons 6 cel)
(cons 48 xk)
(cons 10 pt)
(cons 40 mr)
(list 210 0.0 0.0 1.0)
(cons 50 4.71239)
(cons 51 3.14159)
)
)
(setq en4 (entlast))
;;;生成文字
(entmake (list (cons 0 "TEXT")
(cons 8 "screw")
(CONS 62 6)
(cons 10 textpt)
(cons 40 texth)
(cons 1 text)
(cons 7 "TXT")
(cons 41 1)
(cons 51 0.0)
(cons 71 0)
(cons 72 0)
(cons 73 0)
(list 210 0.0 0.0 1.0)
)
)
(setq en5 (entlast))
;;;做成块
(setq sslist (ssadd))
(ssadd en1 sslist)
(ssadd en2 sslist)
(ssadd en3 sslist)
(ssadd en4 sslist)
(ssadd en5 sslist)
(emkblk sslist pt text )
(princ)
)
;13、entmake生成普通块
;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92482
;by langjs
(defun emkblk (ss pt name / i)
(setvar "cmdecho" 0)
(entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt)))
(repeat (setq i (sslength ss)) (entmake (cdr (entget (ssname ss (setq i (1- i)))))) )
(entmake '((0 . "ENDBLK")))
(command "_.erase" ss "")
(entmake (list '(0 . "INSERT") (cons 8 "screw") (cons 2 name) (cons 10 pt)))
(setvar "cmdecho" 1)
)
(defun usdxf (n entt) (cdr(assoc n entt)))
(defun dxf (m dat) (cdr (assoc m dat)))
(defun dxfucs (m dat) (trans (cdr (assoc m dat)) 0 1))

;;<a href=\"http://bbs.mjtd.com/thread-100947-1-1.html\" target=\"_blank\">http://bbs.mjtd.com/thread-100947-1-1.html</a> 
(defun c:sww() 
  ;----系统变量备份---- 
  (setvar "cmdecho" 0);_关闭命令提示 
  (command "undo" "be") 
  (setq osmode_bak (getvar "osmode"));_记录捕捉 
  (setvar "osmode" 0);_关闭捕捉 
  (setq clayer_bak (getvar "clayer"));_记录当前图层 
  (setq cecolor_bak (getvar "cecolor"));_记录当前颜色 
  (setq celtype_bak (getvar "celtype"));_记录当前线型 
  (setq textstyle_bak (getvar "textstyle"));_记录当前文字样式 
  (setq chksty (tblsearch "style" "TXT")) 
  (if (= chksty nil) 
    (entmake (list '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord") (cons 2 "TXT") 
       '(70 . 0) (cons 40 1) (cons 41 1) '(3 . "txt.shx") '(4 . "gbcbig.shx") 
    ) 
  ) 
    ) 
  (setq chklty (tblsearch "LTYPE" "CENTER")) 
  (if (= chklty nil) 
    (entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord")  '(100 . "AcDbLinetypeTableRecord") 
       (cons 2 "CENTER")  '(3 . "Center ____ _ ____ _ ____ _ ____ _ ____ _ ____") 
       '(70 . 0)  '(73 . 2) '(40 . 15.0) '(49 . 10.0)  '(74 . 0) '(49 . -5.0) '(74 . 0) 
       ) 
       ) 
    ) 
  (setq ss (ssget '((0 . "CIRCLE"))) 
       i  0) 
  (repeat (sslength ss) 
   (setq ename (ssname ss i) 
         dat (entget ename) 
         pt (usdxf 10 dat) 
         r (dxf 40 dat) 
   cel (dxf 6 dat) 
   D (* R 2) 
   ) 
    (if (or (= cel "DASHED") (= cel "HIDDEN")) 
      (setq cel "HIDDEN") 
      (setq cel "Continuous") 
      ) 
    (cond ((= d  2.5) 
     (setq text "M3") 
     (setq xk 0.06) 
     (setq mr 1.5) 
     (makent) 
     ) 
    ((= d 3.3) 
     (setq text "M4") 
     (setq xk 0.08) 
     (setq mr 2) 
     (makent) 
    ) 
    ((= d 4.2) 
     (setq text "M5") 
     (setq xk 0.1) 
     (setq mr 2.5) 
     (makent) 
     ) 
    ((= d 5) 
     (setq text "M6") 
     (setq xk 0.12) 
     (setq mr 3) 
     (makent) 
     ) 
    ((= d 6.8) 
     (setq text "M8") 
     (setq xk 0.16) 
     (setq mr 4) 
     (makent) 
     ) 
    ((= d 8.5) 
     (setq text "M10") 
     (setq xk 0.2) 
     (setq mr 5) 
     (makent) 
     ) 
    ((= d 10.5) 
     (setq text "M12") 
     (setq xk 0.24) 
     (setq mr 6) 
     (makent) 
     ) 
    ((= d 12) 
     (setq text "M14") 
     (setq xk 0.28) 
     (setq mr 7) 
     (makent) 
     ) 
    ((= d 14) 
     (setq text "M16") 
     (setq xk 0.32) 
     (setq mr 8) 
     (makent) 
     ) 
    ((= d 15.5) 
     (setq text "M18") 
     (setq xk 0.36) 
     (setq mr 9) 
     (makent) 
     ) 
    ((= d 17.5) 
     (setq text "M20") 
     (setq xk 0.4) 
     (setq mr 10) 
     (makent) 
     ) 
    ) 
    (setq i (1+ i)) 
   ) 
  ;----系统变量还原---- 
  (setvar "osmode" osmode_bak);_还原捕捉 
  (setvar "clayer" clayer_bak);_还原图层 
  (setvar "cecolor" cecolor_bak);_还原颜色 
  (setvar "celtype" celtype_bak);_还原线型 
  (setvar "textstyle" textstyle_bak);_还原文字样式 
  (command "undo" "e") 
  (setvar "cmdecho" 1);_打开命令提示 
  (princ);_关闭程序返回值 
  ) 
 
(defun makent () 
  ;;;计算点 
  (setq dist (* mr 1.1)) 
  (setq texth (* mr 0.4)) 
  (setq pt1 (polar pt 0 dist)) 
  (setq pt2 (polar pt (* PI 0.5) dist)) 
  (setq pt3 (polar pt pi dist)) 
  (setq pt4 (polar pt (* 1.5 pi) dist)) 
  (setq tept1 (polar pt pi (* mr 2 0.17))) 
  (setq textpt (polar tept1 (* 1.5 pi) (* mr 2 0.25))) 
   
  ;生成圆 
  (entmake (list (cons 0 "CIRCLE") 
     (cons 67 0) 
     (CONS 62 33) 
     (cons 8 "screw") 
     (cons 6  cel) 
     (cons 48 xk) 
     (cons 10 pt) 
     (cons 40 r) 
     ) 
     ) 
  (setq en1 (entlast)) 
  ;生成中心线 
  (entmake (list (cons 0 "LINE") 
     (cons 8 "screw") 
     (CONS 62 1) 
     (cons 6  "CENTER") 
     (cons 48 xk) 
     (cons 10 pt1) 
     (cons 11 pt3) 
      ) 
      ) 
  (setq en2 (entlast)) 
  ;生成中心线 
  (entmake (list (cons 0 "LINE") 
     (cons 8 "screw") 
     (CONS 62 1) 
     (cons 6  "CENTER") 
     (cons 48 xk) 
     (cons 10 pt2) 
     (cons 11 pt4) 
      ) 
      ) 
  (setq en3 (entlast)) 
  ;生成圆弧 
  (entmake (list (cons 0 "ARC") 
     (cons 8 "screw") 
     (CONS 62 92) 
     (cons 6 cel) 
     (cons 48 xk) 
     (cons 10 pt) 
     (cons 40 mr) 
     (list 210 0.0 0.0 1.0) 
     (cons 50 4.71239) 
     (cons 51 3.14159) 
      ) 
      ) 
  (setq en4 (entlast)) 
  ;;;生成文字 
  (entmake (list (cons 0 "TEXT") 
     (cons 8 "screw") 
     (CONS 62 6) 
     (cons 10 textpt) 
     (cons 40 texth) 
     (cons 1 text) 
     (cons 7 "TXT") 
     (cons 41 1) 
     (cons 51 0.0) 
     (cons 71 0) 
     (cons 72 0) 
     (cons 73 0) 
     (list 210 0.0 0.0 1.0) 
      ) 
      ) 
  (setq en5 (entlast)) 
  ;;;做成块 
  (setq sslist (ssadd)) 
  (ssadd en1 sslist) 
  (ssadd en2 sslist) 
  (ssadd en3 sslist) 
  (ssadd en4 sslist) 
  (ssadd en5 sslist) 
  (emkblk sslist pt text ) 
  (princ) 
  ) 
 
;13、entmake生成普通块 
;<a href=\"http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92482\" target=\"_blank\">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=92482</a> 
;by langjs 
(defun emkblk (ss pt name / i) 
  (setvar "cmdecho" 0) 
  (entmake (list '(0 . "block") (cons 2 name) '(70 . 0) (cons 10 pt))) 
  (repeat (setq i (sslength ss))    (entmake (cdr (entget (ssname ss (setq i (1- i))))))  ) 
  (entmake '((0 . "ENDBLK"))) 
  (command "_.erase" ss "") 
  (entmake (list '(0 . "INSERT") (cons 8 "screw") (cons 2 name) (cons 10 pt))) 
  (setvar "cmdecho" 1) 
) 
 
(defun usdxf (n entt) (cdr(assoc n entt))) 
(defun dxf (m dat) (cdr (assoc m dat))) 
(defun dxfucs (m dat)  (trans (cdr (assoc m dat)) 0 1))

st788796 · 发表于 2014-12-11 10:10:53

本帖最后由 st788796 于 2014-12-11 21:00 编辑

lucas3 发表于 2014-12-11 12:42
删除原线条：意思是，圆生成螺纹后，将之前的圆删除掉，程序默认没有删除
显示文字：是否显示螺纹 ...

给你用ODCL写了个，这个应该是 toggle 吧

(defun c:tt (/ ss myerr olderr)
(defun myerr (msg)
(princ "\n*cancel*")
(dcl_form_close screw)
(setq *error* olderr)
(princ)
)
(defun _make (e / r pcen dis lst nl str xk mr cel p1 p2 p3 p4 cir ln)
(setq lst '((2.5 "M3" 0.06 1.5)
(3.3 "M4" 0.08 2.0)
(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)
)
)
(mapcar 'set
'(r pcen)
(xdrx_getpropertyvalue e "radius" "center")
)
(if (setq nl (cdr (assoc (distof (rtos (* r 2) 2 2)) lst)))
(progn
(mapcar 'set
'(str xk mr)
(cdr (assoc (distof (rtos (* r 2) 2 2)) lst))
)
(setq
cel
(if (eq (car (setq lt (xdrx_getpropertyvalue e "linetype")))
"ByLayer"
)
(xdrx_getpropertyvalue
(cadr (xdrx_getpropertyvalue e "layer"))
"linetype"
)
(car lt)
)
)
(setq dis (* mr 1.1)
p1 (polar pcen 0. dis)
p2 (polar pcen _pi2 dis)
p3 (polar pcen pi dis)
p4 (polar pcen (- _pi2) dis)
cir (xdrx_circle_make pcen r)
arc (xdrx_arc_make pcen mr 4.71239 3.14159)
ln (xdrx_line_make (list p1 p3) (list p2 p4))
)
(xdrx_setpropertyvalue
cir "layer" "screw" "color" 33 "linetype" cel "LinetypeScale"
xk)
(xdrx_setpropertyvalue
arc "layer" "screw" "color" 3 "linetype" cel "LinetypeScale"
xk)
(mapcar '(lambda (x)
(xdrx_setpropertyvalue
x "layer" "screw" "color"
1 "linetype" "CENTER" "LinetypeScale"
xk
)
)
(xdrx_pickset->ents ln)
)
(ssadd arc ln)
(ssadd cir ln)
(if (= (dcl_control_getvalue screw_form1_displaytext) 1)
(progn
(setq txt (xdrx_text_make pcen str "TXT" (* mr 0.4) 0.0))
(xdrx_text_setvermode txt 3)
(xdrx_text_sethozmode txt 1)
(xdrx_text_setalignmentpoint
txt
(polar pcen (- _pi2) (* mr 0.17))
)
(ssadd txt ln)
)
)
(if (= (dcl_control_getvalue screw_form1_isBlock) 1)
(xdrx_block_make ln pcen t)
)
)
)
)
(dcl_project_import
'("YWt6AwUNAAB1VXLYBuKTKzUxLT9qgFCuTHRWv+7mxu56rsRe3zskDp+8dnVr0x7892WFxnubq/Y0"
"D181aca48/cBvDmcPG0oxI15hn0yaqPHL9ehZxWZoA098l9Ycw9YPbAJIA2w4tHp/auTVBRZyPJ8"
"EL+5dEJ+kST/A1yuqknyagxK6U70Wqxm3iXk5Frb7baOalabL9pIOxfmzDHXPvOx5mpDNKKI1NQa"
"Ui4p3CH4iFrDW0QdyRoyDelW864V9gX+hF8EWk82tU6bL5iwLfTfM+ykPMcOerg9bRQ1pGS5bKUk"
"HtIH/dCh6OT15zp1fLXSpyoIAx5ALTvCeEPHuaIths+8QWrA1Y5YVXCgqZuQ5WuCIIfRVqKS+5UD"
"n5xTANiODfvhVIIumwHajkn7VXS5w06A0KDNCbkfwnMlYoUyvKsmn8996CkVbTMavo8PuJvmraEf"
"ujNOiwxQx6rcSo8u1Oiz18yBFAMPs5IJEzY+GhL138aIdzLf+RnoO7INiZ5SgbC+otKZz4nkW/tp"
"lIsGIfsQDbRA0Q7+UCl7CdUAzHDpeyEoiAD7UUQCI44HO/F1dDFWAjAfBp8JdXFnmMYEqTrmgAiq"
"go7eI0pZitazc1IdsvAF51Ejgp3Gi9FHToBvOrhhledSEELnBANBSR1EarGlaxAq/MIKYxD3Af5O"
"+bvA35SQKIjSXLrElEU+1jDPEcWFE8Cx1ODThEWC9IHWdo+7ixmDQaePRaLZnIUrw398GY9xdgKy"
"s4sRd1OLqnejX+R236X0bjTpt/tiKA/7ktaeiBAW4z6K1QjEChSL/0EDE1HspOwOce8Ebh8spbEq"
"3eyE/hZc2hBrNOFfbeiGUQMQSRpA+nbn5fGgl7IxMYHZDJ0tB3IfVIncj9ZSlVmqIfwM"
)
)
(dcl_form_show screw)
(apply 'dcl_control_setpos
(cons screw (last (xdrx_document_pixelbox)))
)
;;Main Program
(setq olderr *error*
*error* myerr
)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(xdrx_textstyle_make "txt" "txt.shx" "gbcbig.shx" 0.0 1.0)
(xdrx_linetype_load "Hidden")
(xdrx_linetype_load "Center")
(mapcar '(lambda (x) (_make x)) (xdrx_pickset->ents ss))
)
)
(if (= (dcl_control_getvalue screw_form1_iserased) 1)
(xdrx_entity_delete ss)
)
(dcl_form_close screw)
(setq *error* olderr)
(princ)
)

(defun c:tt (/ ss myerr olderr) 
  (defun myerr (msg) 
    (princ "\n*cancel*") 
    (dcl_form_close screw) 
    (setq *error* olderr) 
    (princ) 
  ) 
  (defun _make (e / r pcen dis lst nl str xk mr cel p1 p2 p3 p4 cir ln) 
    (setq lst '((2.5 "M3" 0.06 1.5) 
                (3.3 "M4" 0.08 2.0) 
                (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) 
               ) 
    ) 
    (mapcar 'set 
            '(r pcen) 
            (xdrx_getpropertyvalue e "radius" "center") 
    ) 
    (if        (setq nl (cdr (assoc (distof (rtos (* r 2) 2 2)) lst))) 
      (progn 
        (mapcar        'set 
                '(str xk mr) 
                (cdr (assoc (distof (rtos (* r 2) 2 2)) lst)) 
        ) 
        (setq 
          cel 
           (if (eq (car (setq lt (xdrx_getpropertyvalue e "linetype"))) 
                   "ByLayer" 
               ) 
             (xdrx_getpropertyvalue 
               (cadr (xdrx_getpropertyvalue e "layer")) 
               "linetype" 
             ) 
             (car lt) 
           ) 
        ) 
        (setq dis (* mr 1.1) 
              p1  (polar pcen 0. dis) 
              p2  (polar pcen _pi2 dis) 
              p3  (polar pcen pi dis) 
              p4  (polar pcen (- _pi2) dis) 
              cir (xdrx_circle_make pcen r) 
              arc (xdrx_arc_make pcen mr 4.71239 3.14159) 
              ln  (xdrx_line_make (list p1 p3) (list p2 p4)) 
        ) 
        (xdrx_setpropertyvalue 
          cir "layer" "screw" "color" 33 "linetype" cel        "LinetypeScale" 
          xk) 
        (xdrx_setpropertyvalue 
          arc "layer" "screw" "color" 3        "linetype" cel "LinetypeScale" 
          xk) 
        (mapcar        '(lambda (x) 
                   (xdrx_setpropertyvalue 
                     x                 "layer"     "screw"         "color" 
                     1                 "linetype"  "CENTER"         "LinetypeScale" 
                     xk 
                    ) 
                 ) 
                (xdrx_pickset->ents ln) 
        ) 
        (ssadd arc ln) 
        (ssadd cir ln) 
        (if (= (dcl_control_getvalue screw_form1_displaytext) 1) 
          (progn 
            (setq txt (xdrx_text_make pcen str "TXT" (* mr 0.4) 0.0)) 
            (xdrx_text_setvermode txt 3) 
            (xdrx_text_sethozmode txt 1) 
            (xdrx_text_setalignmentpoint 
              txt 
              (polar pcen (- _pi2) (* mr 0.17)) 
            ) 
            (ssadd txt ln) 
          ) 
        ) 
        (if (= (dcl_control_getvalue screw_form1_isBlock) 1) 
          (xdrx_block_make ln pcen t) 
        ) 
      ) 
    ) 
  ) 
  (dcl_project_import 
    '("YWt6AwUNAAB1VXLYBuKTKzUxLT9qgFCuTHRWv+7mxu56rsRe3zskDp+8dnVr0x7892WFxnubq/Y0" 
      "D181aca48/cBvDmcPG0oxI15hn0yaqPHL9ehZxWZoA098l9Ycw9YPbAJIA2w4tHp/auTVBRZyPJ8" 
      "EL+5dEJ+kST/A1yuqknyagxK6U70Wqxm3iXk5Frb7baOalabL9pIOxfmzDHXPvOx5mpDNKKI1NQa" 
      "Ui4p3CH4iFrDW0QdyRoyDelW864V9gX+hF8EWk82tU6bL5iwLfTfM+ykPMcOerg9bRQ1pGS5bKUk" 
      "HtIH/dCh6OT15zp1fLXSpyoIAx5ALTvCeEPHuaIths+8QWrA1Y5YVXCgqZuQ5WuCIIfRVqKS+5UD" 
      "n5xTANiODfvhVIIumwHajkn7VXS5w06A0KDNCbkfwnMlYoUyvKsmn8996CkVbTMavo8PuJvmraEf" 
      "ujNOiwxQx6rcSo8u1Oiz18yBFAMPs5IJEzY+GhL138aIdzLf+RnoO7INiZ5SgbC+otKZz4nkW/tp" 
      "lIsGIfsQDbRA0Q7+UCl7CdUAzHDpeyEoiAD7UUQCI44HO/F1dDFWAjAfBp8JdXFnmMYEqTrmgAiq" 
      "go7eI0pZitazc1IdsvAF51Ejgp3Gi9FHToBvOrhhledSEELnBANBSR1EarGlaxAq/MIKYxD3Af5O" 
      "+bvA35SQKIjSXLrElEU+1jDPEcWFE8Cx1ODThEWC9IHWdo+7ixmDQaePRaLZnIUrw398GY9xdgKy" 
      "s4sRd1OLqnejX+R236X0bjTpt/tiKA/7ktaeiBAW4z6K1QjEChSL/0EDE1HspOwOce8Ebh8spbEq" 
      "3eyE/hZc2hBrNOFfbeiGUQMQSRpA+nbn5fGgl7IxMYHZDJ0tB3IfVIncj9ZSlVmqIfwM" 
     ) 
  ) 
  (dcl_form_show screw) 
  (apply 'dcl_control_setpos 
         (cons screw (last (xdrx_document_pixelbox))) 
  ) 
  ;;Main Program 
  (setq        olderr        *error* 
        *error*        myerr 
  ) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (xdrx_textstyle_make "txt" "txt.shx" "gbcbig.shx" 0.0 1.0) 
      (xdrx_linetype_load "Hidden") 
      (xdrx_linetype_load "Center") 
      (mapcar '(lambda (x) (_make x)) (xdrx_pickset->ents ss)) 
    ) 
  ) 
  (if (= (dcl_control_getvalue screw_form1_iserased) 1) 
    (xdrx_entity_delete ss) 
  ) 
  (dcl_form_close screw) 
  (setq *error* olderr) 
  (princ) 
)

st788796 · 发表于 2014-12-11 10:23:48

获取linetype，如果为Bylayer再获取LayerId的linetype

lucas3 · 发表于 2014-12-11 10:46:24

st788796 发表于 2014-12-11 10:23
获取linetype，如果为Bylayer再获取LayerId的linetype

您好，ST大师, 您有时间帮我改改贝，谢谢！

另外想加入个设定的对话框，运行程序后，可输入S 弹出设定：

temp:dialog {
label = "设置" ;
:boxed_column {
label = "选项" ;
:radio_button {
key = "ddd" ;
label = "删除原线条" ;
}
:radio_button {
key = "dtxt" ;
label = "显示文字" ;
}
:radio_button {
key = "mblk" ;
label = "生成块" ;
}
}
ok_cancel;
}

删除原线条：意思是，圆生成螺纹后，将之前的圆删除掉
显示文字：是否显示螺纹大小的文字，如M3 ,M4 ,M5
生成块: 选中后，最后生成的是块，不选中，就不要生成块

以上！谢谢！！！

13808843088 · 发表于 2014-12-11 10:46:41

不知是否理解，给你个判断函数，加进自己的判断部分即可

;;;(setq obj (car (entsel))
;;; typename "HIDDEN"
;;; )
;;;(l_type obj typename)
;;;obj图元名或对象名
;;;typename线型名
;;;返回值t符合线型名，nil不符合
(defun l_type (obj typename / lay ltype btype)
(if (= (type obj) 'ENAME)
(setq obj (vlax-ename->vla-object obj))
)
(setq lay (vla-get-layer obj)
ltype (cdr (assoc 6 (entget (tblobjname "LAYER" lay))))
btype (vla-get-linetype obj)
)
(if (= btype typename)
t
(if (and (= btype "ByLayer") (= ltype typename))
t
nil
)
)
)

st788796 · 发表于 2014-12-11 11:44:36

lucas3 发表于 2014-12-11 10:46
您好，ST大师, 您有时间帮我改改贝，谢谢！

另外想加入个设定的对话框，运行程序后，可输入S 弹出设定 ...

你画个示意图吧，看着太繁琐

lucas3 · 发表于 2014-12-11 12:42:12

本帖最后由 lucas3 于 2014-12-11 12:47 编辑

st788796 发表于 2014-12-11 11:44
你画个示意图吧，看着太繁琐

删除原线条：意思是，圆生成螺纹后，将之前的圆删除掉，程序默认没有删除
显示文字：是否显示螺纹大小的文字，如图中M4 ,M5 ,M6，程序默认是显示文字的
生成块: 选中后，最后生成的是块，不选中，就不要生成块，程序默认是生成块

除了之前提到的判断线型的问题，另外
想加入这个设定的对话框，运行程序后，可输入S 弹出设定：

temp:dialog {
label = "设置" ;
:boxed_column {
label = "选项" ;
:radio_button {
key = "ddd" ;
label = "删除原线条" ;
}
:radio_button {
key = "dtxt" ;
label = "显示文字" ;
}
:radio_button {
key = "mblk" ;
label = "生成块" ;
}
}
ok_cancel;
}

st788796 · 发表于 2014-12-11 13:09:51

文字哪来的？

lucas3 · 发表于 2014-12-11 13:35:15

st788796 发表于 2014-12-11 13:09
文字哪来的？

一楼的程序建立文字样式写入的

st788796 · 发表于 2014-12-11 19:36:20

lucas3 发表于 2014-12-11 13:35
一楼的程序建立文字样式写入的

看着太啰嗦，用 API 简化，没有测试

(defun c:tt (/ ss)
(defun _make (e l / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln)
(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)
)
)
(mapcar 'set
'(r pcen)
(xdrx_getpropertyvalue e "radius" "center")
)
(mapcar 'set '(str xk mr) (cdr (assoc r lst)))
(setq
cel (if (eq (car (setq lt (xdrx_getpropertyvalue e "linetype"))
"ByLayer"
)
)
(xdrx_getpropertyvalue
(cadr (xdrx_getpropertyvalue e "layer"))
"linetype"
)
(car 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)
cir (xdrx_circle_make pcen r)
arc (xdrx_arc_make pcen mr 4.71239 3.14159)
)
(xdrx_setpropertyvalue
cir "layer" "screw" "color" 33 "linetype" cel "LinetypeScale" xk)
(xdrx_setpropertyvalue
ln "layer" "screw" "color" 92 "linetype" "CENTER" "LinetypeScale"
xk)
(setq ln (xdrx_line_make (list (list p1 p3) (list p2 p4))))
(xdrx_setpropertyvalue
ln "layer" "screw" "color" 1 "linetype" "CENTER" "LinetypeScale"
xk)
(ssadd arc ln)
(ssadd cir ln)
(xdrx_block_make ln pcen t)
)
(if (setq ss (ssget '((0 . "circle"))))
(progn
(xdrx_textstyle_make "txt" "txt.shx" "gbcbig.shx" 0.0 1.0)
(xdrx_linetype_load "Hidden")
(mapcar '(lambda (x) (_make x)) (xdrx_pickset->ents ss))
)
)
(princ)
)

(defun c:tt (/ ss) 
  (defun _make (e l / r pcen dis lst str xk mr cel p1 p2 p3 p4 cir ln) 
    (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) 
               ) 
    ) 
    (mapcar 'set 
            '(r pcen) 
            (xdrx_getpropertyvalue e "radius" "center") 
    ) 
    (mapcar 'set '(str xk mr) (cdr (assoc r lst))) 
    (setq 
      cel (if (eq (car (setq lt (xdrx_getpropertyvalue e "linetype")) 
                       "ByLayer" 
                  ) 
              ) 
            (xdrx_getpropertyvalue 
              (cadr (xdrx_getpropertyvalue e "layer")) 
              "linetype" 
            ) 
            (car 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) 
          cir (xdrx_circle_make pcen r) 
          arc (xdrx_arc_make pcen mr 4.71239 3.14159) 
    ) 
    (xdrx_setpropertyvalue 
      cir "layer" "screw" "color" 33 "linetype"        cel "LinetypeScale" xk) 
    (xdrx_setpropertyvalue 
      ln "layer" "screw" "color" 92 "linetype" "CENTER"        "LinetypeScale" 
      xk) 
    (setq ln (xdrx_line_make (list (list p1 p3) (list p2 p4)))) 
    (xdrx_setpropertyvalue 
      ln "layer" "screw" "color" 1 "linetype" "CENTER" "LinetypeScale" 
      xk) 
    (ssadd arc ln) 
    (ssadd cir ln) 
    (xdrx_block_make ln pcen t) 
  ) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (progn 
      (xdrx_textstyle_make "txt" "txt.shx" "gbcbig.shx" 0.0 1.0) 
      (xdrx_linetype_load "Hidden") 
      (mapcar '(lambda (x) (_make x)) (xdrx_pickset->ents ss)) 
    ) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-12-12 09:16:00

st788796 发表于 2014-12-11 20:56
给你用ODCL写了个，这个应该是 toggle 吧

整复杂了哈，LISP都不会，现在又来API+ODCL, 更摸不到头脑了，以前API只有一个单文件XDRX_API.R2007.arx ，现在下载下来的是一个文件夹，好多文件，{:soso_e127:} 装了ODCL，不会玩，没找到opendcl.xx.arx, 试着整了下，no function definition: DCL_PROJECT_IMPORT，头爆炸了....{:soso_e126:}

Free-Lancer · 发表于 2014-12-15 09:09:09

本帖最后由 Free-Lancer 于 2014-12-15 09:11 编辑

lucas3 发表于 2014-12-12 09:16
整复杂了哈，LISP都不会，现在又来API+ODCL, 更摸不到头脑了，以前API只有一个单文件XDRX_API.R2007.arx ...

Opendcl 要装 Runtime 在 ODCL 论坛由 8.10 链接下载，命令行输入 opendcl 就可以使用了
简单改写了下，st 给了框架，某些语句替换下即可，DCL 部分没有写完，你试着自己写写，有问题到这里交流

(defun c:tt (/ ss dcl fn id isBlock isErased isText)
(defun _make
(e l / 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 (car (setq lt (vlax-get e "linetype"))
"ByLayer"
)
)
(vlax-get
(vla-item (fy:aclayers) (vlax-get e "layer"))
"linetype"
)
(car 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 isBlock
(setq space (vlax-invoke (fy:acblocks) 'add pcen "*"))
(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 isText
(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 isBlock
(vlax-invoke
(fy:acspace)
'insertblock
pcen
(vla-get-name space)
1.
1.
1.
0.
)
)
)
(setq dcl '("screw:dialog{"
"label = \"参数设置\";"
" :toggle{ key = \"isErased\"; label = \"删除原文字\";}"
" :toggle { key = \"isText\"; label = \"显示文字\";}"
" :toggle { key = \"isBlock\"; label = \"生成块\";}"
" ok_cancel;"
"}"
)
fn (xd::dcl:make dcl)
)
(fy:begin)
(if (setq ss (ssget '((0 . "circle"))))
(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")
)
(mapcar '(lambda (x) (_make x)) (fy:cset->objs))
(if isErased (command ".erase" ss ""))
)
)
(princ)
)

(defun c:tt (/ ss dcl fn id isBlock isErased isText) 
  (defun _make 
         (e l / 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 (car (setq lt (vlax-get e "linetype")) 
                       "ByLayer" 
                  ) 
              ) 
            (vlax-get 
              (vla-item (fy:aclayers) (vlax-get e "layer")) 
              "linetype" 
            ) 
            (car 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        isBlock 
      (setq space (vlax-invoke (fy:acblocks) 'add pcen "*")) 
      (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        isText 
      (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        isBlock 
      (vlax-invoke 
        (fy:acspace) 
        'insertblock 
        pcen 
        (vla-get-name space) 
        1. 
        1. 
        1. 
        0. 
      ) 
    ) 
  ) 
  (setq        dcl '("screw:dialog{" 
              "label = \"参数设置\";" 
              " :toggle{ key = \"isErased\"; label = \"删除原文字\";}" 
              " :toggle { key = \"isText\"; label = \"显示文字\";}" 
              " :toggle { key = \"isBlock\"; label = \"生成块\";}" 
              " ok_cancel;" 
              "}" 
             ) 
        fn  (xd::dcl:make dcl) 
  ) 
  (fy:begin) 
  (if (setq ss (ssget '((0 . "circle")))) 
    (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") 
      ) 
      (mapcar '(lambda (x) (_make x)) (fy:cset->objs)) 
      (if isErased (command ".erase" ss "")) 
    ) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-12-15 12:50:48

Free-Lancer 发表于 2014-12-15 09:09
Opendcl 要装 Runtime 在 ODCL 论坛由 8.10 链接下载，命令行输入 opendcl 就可以使用了
简单改写了 ...

好的，谢谢大师出手相助，我先试试

lucas3 · 发表于 2014-12-15 22:45:28

本帖最后由 lucas3 于 2014-12-15 22:53 编辑

Free-Lancer 发表于 2014-12-15 09:09
Opendcl 要装 Runtime 在 ODCL 论坛由 8.10 链接下载，命令行输入 opendcl 就可以使用了
简单改写了 ...

Free-Lancer大师，稍微改了下，怎么对话框弹出就闪退呢？并显示：命令: TT ; 错误: 参数太少

…………
(setq dcl '("screw:dialog{"
"label = \"参数设置\";"
" :toggle{ key = \"isErased\"; label = \"删除原文字\";}"
" :toggle { key = \"isText\"; label = \"显示文字\";}"
" :toggle { key = \"isBlock\"; label = \"生成块\";}"
" ok_cancel;"
"}"
)
fn (xd::dcl:make dcl)
id (xd::dcl:load fn "screw")
)
(XD::Dcl:Accept)
(xd::dcl:start id fn)
(fy:begin)
…………

lucas3 · 发表于 2014-12-19 11:17:47

Free-Lancer 发表于 2014-12-15 09:09
Opendcl 要装 Runtime 在 ODCL 论坛由 8.10 链接下载，命令行输入 opendcl 就可以使用了
简单改写了 ...

大师，能不能再抽点点时间帮忙看看？谢谢了

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

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

最佳答案

点评

点评

评分

点评

点评

点评

点评