[求助]编一个增强型align命令
<font face="宋体" size="2">cad自带的align命令在输入目标点时要么点取屏幕上某一点，要么用键盘输入坐标，能否编一个可以点取图上坐标数据进行align的增强型命令，里面的坐标数据可能是text,也可能是块，也可能是组，前面一般带有前缀“X=”或“X ”，“Y=”或“Y ”等字样，请注意测量坐标系统中的X、Y和屏幕上的X、Y是反的，对那些没前缀的可以由程序提示设计输入是X还是Y ，坐标标注方式见附件</font><br/><br/><!--Element not supported - Type: 8 Name: #comment--> 未測試的(DEFUN C:TEST (/ ALB ALB1 ALB2 ALB3 ALB4 ALEN ALPOINTL DXF NB TEXT VE1 XB XT1 YT1)
(SETQ ALEN(ENTSEL"\n選對齊對象:"))
(SETQ ALB1(CAR(ENTSEL"\n對齊第一點:"))
ALB2(CAR(ENTSEL"\n對齊第二點:"))
ALB3(CAR(ENTSEL"\n對齊第三點:"))
ALB4(CAR(ENTSEL"\n對齊第四點:")))
(IF(AND ALB1 ALB2 ALB3 ALB4)
(PROGN
(SETQ ALPOINTL NIL ALB(LIST ALB1 ALB2 ALB3 ALB4))
(FOREACH E1 ALB;(SETQ E1 ALB1)Q
(SETQ XB NIL TEXT NIL VE1(VLAX-ENAME->VLA-OBJECT E1))
(SETQ NB(VLAX-VLA-OBJECT->ENAME(VLA-COPY VE1)))
(COMMAND ".EXPLODE" NB)
(while(setq NB(entnext NB))
(SETQ DXF(ENTGET NB))
(IF(EQ(CDR(ASSOC 0 DXF))"TEXT")
(SETQ TEXT(CONS (CDR(ASSOC 1 DXF))TEXT)))
(SETQ XB(CONS NB XB)))
(FOREACH E1 XB(ENTDEL E1))
(IF TEXT
(PROGN
(FOREACH T1 TEXT;(SETQ T1(CAR TEXT))
(IF(wcmatch T1 "X*")
(PROGN(SETQ XT1(VL-STRING-TRIM "X"T1))
(IF(wcmatch XT1 "=*")(SETQ XT1(VL-STRING-TRIM "="XT1)))
(SETQ XT1(ATOF XT1))))
(IF(wcmatch T1 "Y*")
(PROGN(SETQ YT1(VL-STRING-TRIM "Y"T1))
(IF(wcmatch YT1 "=*")(SETQ YT1(VL-STRING-TRIM "="YT1)))
(SETQ YT1(ATOF YT1)))))
(SETQ ALPOINTL(CONS(LIST XT1 YT1)ALPOINTL))))
)
;; align
(command ".ALIGN" ALEN "" (CAR ALPOINTL)(CADR ALPOINTL)(CADDR ALPOINTL)(CADDDR ALPOINTL) "" "y")
))
(PRINC)
) 你编错了，源点，也就是第一和第二点是从图中点取具体坐标（不是数据）<br/>运行结果如下：選對齊對象:<br/>對齊第一點:<br/>對齊第二點:<br/>對齊第三點:<br/>對齊第四點:; 错误: no function definition: VLA-OBJECT->ENAME<br/><br/> <p>;增强型align V1.0 by sailorcwx 2007.01<br/>;目前只支持包含XY信息的图块，其余的以后增加</p><p>(defun c:al1 (/ YH_ALSELECT YH_POINT1 YH_POINT2 YH_POINT3 YH_POINT4)<br/> (setq YH_alselect (ssget)<br/> YH_point1 (YH_getpoint nil "第一个源点")<br/> YH_point2 (YH_getpoint YH_point1 "第一个目标点")<br/> YH_point3 (YH_getpoint nil "第二个源点")<br/> YH_point4 (YH_getpoint YH_point3 "第二个目标点")<br/> )<br/> (command "ALIGN" YH_alselect "" YH_point1 YH_point2 YH_point3 YH_point4 "")<br/> (princ)<br/> )<br/>(defun YH_getpoint (YH_lastpoint YH_info / YH_BLOCKDATA YH_POINT YH_POINTX YH_POINTY YH_UCSBLOCK)<br/> (if (not YH_lastpoint)<br/> (setq YH_point (getpoint (strcat "\n选择" YH_info "或选择一个坐标数据:")))<br/> (setq YH_point (getpoint YH_lastpoint (strcat "\n选择" YH_info "或选择一个坐标数据:")))<br/> )<br/> (if (not YH_point)<br/> (progn<br/> (setq YH_ucsblock (tblobjname "block" (cdr (assoc 2 (entget (car (entsel "\n选择坐标数据:")))))))<br/> (setq YH_pointX nil YH_pointY nil)<br/> (while (setq YH_ucsblock (entnext YH_ucsblock))<br/> (setq YH_blockdata (entget YH_ucsblock))<br/> (if (= (cdr (assoc 0 YH_blockdata)) "TEXT")<br/> (progn<br/> (if (= (substr (cdr (assoc 1 YH_blockdata)) 1 1) "X") (setq YH_pointX (substr (cdr (assoc 1 YH_blockdata)) 3)))<br/> (if (= (substr (cdr (assoc 1 YH_blockdata)) 1 1) "Y") (setq YH_pointY (substr (cdr (assoc 1 YH_blockdata)) 3)))<br/> )<br/> )<br/> )<br/> (if (and YH_pointX YH_pointY) (setq YH_point (list (atof YH_pointY) (atof YH_pointX))))<br/> )<br/> )<br/> YH_point <br/> )</p> 本帖最后由 作者 于 2007-2-15 9:37:40 编辑 <br /><br /> http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58121<br/>http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58120这两个贴子也是我发的，去顶一下
页:
[1]