找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 809|回复: 0

[LISP程序]:写了一个多义线自动标注程序,有点问题。。。

[复制链接]
发表于 2007-9-1 21:58:58 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
刚刚学了几天lisp,连抄带蒙写了下面一个自动标注多义线的lisp,主要是两部分,第一部分是对多义线修正,删除多余的重复点,第二是自动标注。。。现在出现了一个问题,在修正后新生出来的多义线不能直接应用到自动标注,不知道是不是对象不对的原因。
请问这个程序应该怎么改才能直接把新生出来的多义线直接用于自动标注上?谢谢。。。

(defun c:cd ()
(vl-load-com)
;;;定义字高
; (setq li (getreal "\n 标注字体高度:"))
(setq li 4)
;;;获取对象
(eee)
(princ "\n选取PLINE多义线...")
(setq ss (ssget))
;;;建立定位辅助线
(setq xy (getpoint "\n 标注偏移方向:"))

;;;建立辅助线
(cmd1)
(command "OFFSET" (/ li 2) ss xy "")
(setq de (entlast))

;;;建立原多义线端点数据库
(setq obj (vlax-ename->vla-object (ssname ss 0)))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj)
)
)
)

;;;建立辅助多义线端点数据库
(setq obj1 (vlax-ename->vla-object de ))
(setq plist1 (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj1)
)
)
)

;;;获得多义线子段数目

(setq num (/ (length plist) 2))
(princ num)
(princ "\n")
(setq n 0)
;;;标注,除最后一段
(repeat (1- num)
(setq pt1 (list (nth (* n 2) plist) (nth (1+ (* n 2)) plist)))
(setq pt2 (list (nth (* (1+ n) 2) plist)
(nth (1+ (* (1+ n) 2)) plist)
)
)

(setq pt3 (list (nth (* n 2) plist1) (nth (1+ (* n 2)) plist1)))
(setq pt4 (list (nth (* (1+ n) 2) plist1)
(nth (1+ (* (1+ n) 2)) plist1)
)
)

(setq n (1+ n))
(princ n)
(princ "\n")
(dimm)
)

;;;;;;标注最后一段
(setq pt1 (list (nth (* n 2) plist) (nth (1+ (* n 2)) plist)))
(setq pt2 (list (nth 0 plist) (nth 1 plist)))

(setq pt3 (list (nth (* n 2) plist1) (nth (1+ (* n 2)) plist1)))
(setq pt4 (list (nth 0 plist1) (nth 1 plist1)))

(princ n)
(princ "/n")
(dimm)

(command "ERASE" de "")
(cmd2)
)


;;;通用标注子程序
(defun dimm ()
(setq pt5 (mapcar '(lambda (x) (/ x 2) ) (mapcar '+ pt3 pt4)))
(command "_dimaligned" pt1 pt2 pt5)

)


;;; 保存原有系统变量,设置程序运行时的系统变量
(Defun cmd1 ()
(Setq cho (Getvar "Cmdecho")
osm (Getvar "Osmode")
)
(Setvar "Cmdecho" 0)
(Setvar "osmode" 0)
)



;;; 恢复原有系统变量
(Defun cmd2 ()
(Setvar "Cmdecho" cho)
(Setvar "Osmode" osm)
(Terpri)
(Princ)
)


(defun eee (/ N A AA AAA)
(setq A (car (entsel)))
(command "_.explode" A)
(setq A (ssget "p"))
(setq N 0)
(setq AA (ssadd))
(repeat (sslength A)
(if (and (/= "LINE" (assoc 0 (entget (ssname A N))))
(not (equal (cdr (assoc 10 (entget (ssname A N))))
(cdr (assoc 11 (entget (ssname A N))))
)
)
)
(ssadd (ssname A N) AA)
(command "_.erase" (ssname A N) "")
)
(setq N (1+ N))
)
(command "_.pedit" (SSNAME AA 0) "y" "j" AA "" "")
(princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-17 05:50 , Processed in 0.332679 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表