[分享]zzgl(Z轴归零)
<p><font face="Verdana">zzgl(Z轴归零)：zzgl</font></p><p></p> 本帖最后由 作者 于 2010-9-26 22:36:13 编辑
借院长宝地，发一下我拼凑的ZZGL;原理是对ACAD自身图元进行归零，对无法使用修改标高归零的对象通过MOVE移动到无穷远再移回来；经常使用，比较彻底
;;;Z轴归零
(defun C:ZZGL (/ ss tmpucsolderroldcmdzeroz ss1
ss1leni numchgnumnotnumno0ssno0 ename
elist etype yorn vrt crz
)
(setq tmpucs "$FLATTEN-TEMP$") ;temporary UCS
;;Error handler
(setq olderr *error*)
(defun *error* (msg)
(if (or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
;;if user cancelled or program aborted, exit quietly
(princ)
;;otherwise report error message
(princ (strcat "\nError: " msg))
)
(setq *error* olderr)
(if (tblsearch "UCS" tmpucs)
(command "._UCS" "_Restore" tmpucs "._UCS" "_Delete" tmpucs)
)
(command "._UNDO" "_End")
(setvar "CMDECHO" oldcmd)
(princ)
)
;;Function to change Z coordinate to 0
(defun zeroz (key zelist / oplist nplist)
(setq oplist (assoc key zelist)
nplist (reverse (append '(0.0) (cdr (reverse oplist))))
zelist (subst nplist oplist zelist)
)
(entmod zelist)
)
;;Setup
(setq oldcmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "._UNDO" "_Group")
(command "._UCS" "_Delete" tmpucs "._UCS" "_Save" tmpucs "._UCS"
"_World")
;;Get input
(setq ss1 (ssget))
(if (null ss1) ;if enter...
(setq ss1 (ssget "_X"));select all entities in database
)
;;*initialize variables
(setq ss1len (sslength ss1);length of selection set
i 0 ;loop counter
numchg 0 ;number changed counter
numnot 0 ;number not changed counter
numno0 0 ;number not changed and Z /= 0 counter
ssno0(ssadd) ;selection set of unchanged entities
) ;setq
;;*do the work
(prompt "\nWorking.")
(while (< i ss1len) ;while more members in the SS
(if (= 0 (rem i 10))
(prompt ".")
)
(setq ename (ssname ss1 i);entity name
elist (entget ename);entity data list
etype (cdr (assoc 0 elist)) ;entity type
)
;;*Keep track of entities not flattened
(if (not (member etype
'("3DFACE" "ARC""ATTDEF"
"CIRCLE" "DIMENSION""ELLIPSE"
"HATCH" "INSERT""LINE"
"LWPOLYLINE" "MTEXT""POINT"
"POLYLINE" "SOLID""TEXT"
)
)
)
(progn ;leave others alone
(setq numnot (1+ numnot))
(if (/= 0.0 (car (reverse (assoc 10 elist))))
(progn ;add it to special list if Z /= 0
(setq numno0 (1+ numno0))
(ssadd ename ssno0)
)
)
)
)
;;Change group 10 Z coordinate to 0 for listed entity types.
(if (member etype
'("3DFACE" "ARC" "ATTDEF" "CIRCLE"
"DIMENSION" "ELLIPSE" "HATCH" "INSERT"
"LINE" "MTEXT" "POINT" "POLYLINE"
"SOLID" "TEXT"
)
)
(setq elist(zeroz 10 elist) ;change entities in list above
numchg (1+ numchg)
)
)
;;Change group 11 Z coordinate to 0 for listed entity types.
(if (member etype
'("3DFACE" "ATTDEF" "DIMENSION" "LINE" "TEXT" "SOLID")
)
(setq elist (zeroz 11 elist))
)
;;Change groups 12 and 13 Z coordinate to 0 for SOLIDs and 3DFACEs.
(if (member etype '("3DFACE" "SOLID"))
(progn
(setq elist (zeroz 12 elist))
(setq elist (zeroz 13 elist))
)
)
;;Change groups 13, 14, 15, and 16
;;Z coordinate to 0 for DIMENSIONs.
(if (member etype '("DIMENSION"))
(progn
(setq elist (zeroz 13 elist))
(setq elist (zeroz 14 elist))
(setq elist (zeroz 15 elist))
(setq elist (zeroz 16 elist))
)
)
;;Change each polyline vertex Z coordinate to 0.
;;Code provided by Vladimir Livshiz, 09-Oct-1998
(if (= etype "POLYLINE")
(progn
(setq vrt ename)
(while (not (equal (cdr (assoc 0 (entget vrt))) "SEQEND"))
(setq elist (entget (entnext vrt)))
(setq crz (cadddr (assoc 10 elist)))
(if (/= crz 0)
(progn
(zeroz 10 elist)
(entupd ename)
)
)
(setq vrt (cdr (assoc -1 elist)))
)
)
)
;;Special handling for LWPOLYLINEs
(if (member etype '("LWPOLYLINE"))
(progn
(setq elist(subst (cons 38 0.0) (assoc 38 elist) elist)
numchg (1+ numchg)
)
(entmod elist)
)
)
(setq i (1+ i)) ;next entity
)
;;Print results
(prompt (strcat "\n" (itoa numchg) " AutoCad实体归零."))
(prompt
(strcat "\n" (itoa numnot) " 个非AutoCad实体未归零.")
)
(princ "\n二次归零...")
(if (and ssno0 (> numnot 0))
(progn
(setvar "cmdecho" 0)
(princ "\n正在处理图形数据，请稍候．．．")
(terpri)
(command ".ucs" "w")
(command ".move" ssno0 "" '(0 0 1e99) ""
".move" "p" "" '(0 0 -1e99) "")
(princ "\n已将所选图元Z坐标值全部归零")
)
)
;;If there any entities in ssno0, show them
(command "._UCS" "_Restore" tmpucs "._UCS" "_Delete" tmpucs)
(command "._UNDO" "_End")
(setvar "CMDECHO" oldcmd)
(setq *error* olderr)
(princ "\n高山流水Z轴归零程序，命令ZZGL")
)
我觉得做成“Z值归零”一个函数→用来应对“连接直线与多段线”→不同标高或者Z值时→需要手动调整后再执行连接命令的情况→以最快速度统一归一个具体值→再执行连接功能→会比较快捷！ chlh_jd 发表于 2010-8-31 21:34
借院长宝地，发一下我拼凑的ZZGL;原理是对ACAD自身图元进行归零，对无法使用修改标高归零的对象通过MOVE移 ...
程序整理不出来啊 <p>下载了几次没下载成功，占个一楼跟高手亲密接触下</p> liminnet发表于2010-8-31 21:48:00static/image/common/back.gif三楼看来是踢馆的
<p>欢迎踢馆！</p> <p>要那么复杂的程序吗？我看见别人好象很简单的就行了</p>
<p>收藏了，看看学习学习。</p>
<p>谢谢3楼的分享</p> <p>我看行</p> 看看找点东西,谢谢!(部分拿来主义) <p>三楼的不错，很好用，二次归零也不错，避免一次归零有落下的，不过一般一次归零就可以了，顶，但是最后会有一句未知zzgl命令不知道是哪里出了错误。</p> <font face="Verdana">(defun c:zzgl ()<br/> (setvar "CMDECHO" 0)<br/> (command ".MOVE" "ALL" "" "0,0,0" "0,0,10000e99"<br/> ".MOVE" "P" "" "0,0,10000e99" "0,0,0")<br/> (setvar "CMDECHO" 1)<br/> (princ)<br/>)</font>
页:
[1]
2