[求助]编一个增强型align命令

raobinhsh

cad自带的align命令在输入目标点时要么点取屏幕上某一点，要么用键盘输入坐标，能否编一个可以点取图上坐标数据进行align的增强型命令，里面的坐标数据可能是text,也可能是块，也可能是组，前面一般带有前缀“X=”或“X ”，“Y=”或“Y ”等字样，请注意测量坐标系统中的X、Y和屏幕上的X、Y是反的，对那些没前缀的可以由程序提示设计输入是X还是Y ，坐标标注方式见附件

BDYCAD

未測試的

2. (DEFUN C:TEST (/ ALB ALB1 ALB2 ALB3 ALB4 ALEN ALPOINTL DXF NB TEXT VE1 XB XT1 YT1)
3.   (SETQ ALEN(ENTSEL"\n選對齊對象:"))
4.   (SETQ ALB1(CAR(ENTSEL"\n對齊第一點:"))
5. ALB2(CAR(ENTSEL"\n對齊第二點:"))
6. ALB3(CAR(ENTSEL"\n對齊第三點:"))
7. ALB4(CAR(ENTSEL"\n對齊第四點:")))
8.   (IF(AND ALB1 ALB2 ALB3 ALB4)
9.     (PROGN
10.       
11.       (SETQ ALPOINTL NIL ALB(LIST ALB1 ALB2 ALB3 ALB4))
12.    (FOREACH E1 ALB;(SETQ E1 ALB1)Q
13.      (SETQ XB NIL TEXT NIL VE1(VLAX-ENAME->VLA-OBJECT E1))
14.      (SETQ NB(VLAX-VLA-OBJECT->ENAME(VLA-COPY VE1)))
15.      (COMMAND ".EXPLODE" NB)
16.      (while(setq NB(entnext NB))
17.        (SETQ DXF(ENTGET NB))
18.        (IF(EQ(CDR(ASSOC 0 DXF))"TEXT")
19.   (SETQ TEXT(CONS (CDR(ASSOC 1 DXF))TEXT)))
20.        (SETQ XB(CONS NB XB)))
21.      (FOREACH E1 XB(ENTDEL E1))
22.      (IF TEXT
23.        (PROGN
24.        (FOREACH T1 TEXT;(SETQ T1(CAR TEXT))
25.   (IF(wcmatch T1 "X*")
26.     (PROGN(SETQ XT1(VL-STRING-TRIM "X"T1))
27.       (IF(wcmatch XT1 "=*")(SETQ XT1(VL-STRING-TRIM "="XT1)))
28.       (SETQ XT1(ATOF XT1))))
29.   (IF(wcmatch T1 "Y*")
30.     (PROGN(SETQ YT1(VL-STRING-TRIM "Y"T1))
31.       (IF(wcmatch YT1 "=*")(SETQ YT1(VL-STRING-TRIM "="YT1)))
32.       (SETQ YT1(ATOF YT1)))))
33.        (SETQ ALPOINTL(CONS(LIST XT1 YT1)ALPOINTL))))
34.      )
35.      ;; align
36. (command ".ALIGN" ALEN "" (CAR ALPOINTL)(CADR ALPOINTL)(CADDR ALPOINTL)(CADDDR ALPOINTL) "" "y")
37.   ))
38.      
39.    (PRINC)
40. )

(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) )

raobinhsh

你编错了，源点，也就是第一和第二点是从图中点取具体坐标（不是数据）
运行结果如下：選對齊對象:
對齊第一點:
對齊第二點:
對齊第三點:
對齊第四點:; 错误: no function definition: VLA-OBJECT->ENAME

sailorcwx

;增强型align V1.0 by sailorcwx 2007.01
;目前只支持包含XY信息的图块，其余的以后增加

(defun c:al1 (/ YH_ALSELECT YH_POINT1 YH_POINT2 YH_POINT3 YH_POINT4)
  (setq YH_alselect (ssget)
 YH_point1 (YH_getpoint nil "第一个源点")
 YH_point2 (YH_getpoint YH_point1 "第一个目标点")
 YH_point3 (YH_getpoint nil "第二个源点")
 YH_point4 (YH_getpoint YH_point3 "第二个目标点")
 )
  (command "ALIGN" YH_alselect "" YH_point1 YH_point2 YH_point3 YH_point4 "")
  (princ)
  )
(defun YH_getpoint (YH_lastpoint YH_info / YH_BLOCKDATA YH_POINT YH_POINTX YH_POINTY YH_UCSBLOCK)
  (if (not YH_lastpoint)
    (setq YH_point (getpoint (strcat "\n选择" YH_info "或选择一个坐标数据:")))
    (setq YH_point (getpoint YH_lastpoint (strcat "\n选择" YH_info "或选择一个坐标数据:")))
    )
  (if (not YH_point)
    (progn
      (setq YH_ucsblock (tblobjname "block" (cdr (assoc 2 (entget (car (entsel "\n选择坐标数据:")))))))
      (setq YH_pointX nil YH_pointY nil)
      (while (setq YH_ucsblock (entnext YH_ucsblock))
 (setq YH_blockdata (entget YH_ucsblock))
 (if (= (cdr (assoc 0 YH_blockdata)) "TEXT")
   (progn
     (if (= (substr (cdr (assoc 1 YH_blockdata)) 1 1) "X") (setq YH_pointX (substr (cdr (assoc 1 YH_blockdata)) 3)))
     (if (= (substr (cdr (assoc 1 YH_blockdata)) 1 1) "Y") (setq YH_pointY (substr (cdr (assoc 1 YH_blockdata)) 3)))
     )
   )
 )
      (if (and YH_pointX YH_pointY) (setq YH_point (list (atof YH_pointY) (atof YH_pointX))))
      )
    )
 YH_point
  )

raobinhsh

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58121
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=58120这两个贴子也是我发的，去顶一下