[分享]zzgl(Z轴归零)

xyp1964 · 发表于 2010-8-31 17:18

zzgl(Z轴归零)：zzgl

寒潮大冬瓜 · 发表于 2024-6-14 00:11

我觉得做成“Z值归零”一个函数→用来应对“连接直线与多段线”→不同标高或者Z值时→需要手动调整后再执行连接命令的情况→以最快速度统一归一个具体值→再执行连接功能→会比较快捷！

尘缘一生 · 发表于 2021-8-31 20:08

chlh_jd 发表于 2010-8-31 21:34
借院长宝地，发一下我拼凑的ZZGL;原理是对ACAD自身图元进行归零，对无法使用修改标高归零的对象通过MOVE移 ...

程序整理不出来啊

广厦千万 · 发表于 2021-9-1 07:48

谢谢分享下载学习

chlh_jd · 发表于 2010-8-31 21:30

下载了几次没下载成功，占个一楼跟高手亲密接触下

chlh_jd · 发表于 2010-8-31 21:34

本帖最后由作者于 2010-9-26 22:36:13 编辑

借院长宝地，发一下我拼凑的ZZGL;原理是对ACAD自身图元进行归零，对无法使用修改标高归零的对象通过MOVE移动到无穷远再移回来；经常使用，比较彻底

;;;Z轴归零
(defun C:ZZGL (/ ss tmpucs olderr oldcmd zeroz ss1
ss1len i numchg numnot numno0 ssno0 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轴归零
(defun C:ZZGL (/       ss      tmpucs  olderr  oldcmd  zeroz   ss1
        ss1len  i       numchg  numnot  numno0  ssno0   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")
)

liminnet · 发表于 2010-8-31 21:48

提示: 作者被禁止或删除内容自动屏蔽

xyp1964 · 发表于 2010-8-31 22:57

liminnet发表于2010-8-31 21:48:00三楼看来是踢馆的

欢迎踢馆！

461045462 · 发表于 2010-9-1 06:15

要那么复杂的程序吗？我看见别人好象很简单的就行了

收藏了，看看学习学习。

谢谢3楼的分享

maomao0416 · 发表于 2010-9-19 17:01

我看行

lvchunhu · 发表于 2010-9-24 01:02

看看找点东西,谢谢!(部分拿来主义)

linshiyin2 · 发表于 2010-9-24 17:31

三楼的不错，很好用，二次归零也不错，避免一次归零有落下的，不过一般一次归零就可以了，顶，但是最后会有一句未知zzgl命令不知道是哪里出了错误。

linshiyin2 · 发表于 2010-9-24 20:38

(defun c:zzgl ()
(setvar "CMDECHO" 0)
(command ".MOVE" "ALL" "" "0,0,0" "0,0,10000e99"
".MOVE" "P" "" "0,0,10000e99" "0,0,0")
(setvar "CMDECHO" 1)
(princ)
)

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

liminnet liminnet 当前离线积分 9742 明经币个注册时间 2007-8-22 在线时间小时威望金钱个贡献激情	发表于 2010-8-31 21:48 \| 显示全部楼层提示: 作者被禁止或删除内容自动屏蔽

	回复支持反对使用道具举报显身卡

[分享]zzgl(Z轴归零)

本帖子中包含更多资源