Question

autolisp 输入的列表有缺陷 ; 错误: 参数太多: (IF (= ( ... ) 1) (SETQ PTLST ( ... )) (SETQ N ( ... )

作用是，边长长度自动注记
代码如下
(defun mkptlst (pen1 / bhbj ptlst pen pel pt i pt1 pt2)
;;取出"polyline" 或 lwpolyline的点位，以表的结构返回
(if( = ( cdr (assoc 0 (entget pen1))) "POLYLINE")
(progn (setq ptlst '())
(setq pen (entnext pen1))
(while (/ = "SEQEND" ( cdr (assoc 0 (entget pen))))
(setq pel (entget pen))
(setq pt ( cdr (assoc 10 pel)))
(setq ptlst (append ptlst (list pt)))
(setq pen (entnext pen))
)
(setq bhbj ( cdr (assoc 70 (entget pen1))))
(if( = (logand bhbj 1) 1)
(setq ptlst (mkptlst stm))
(setq n (length ptlst))
(setq j 0)
(while ( < j ( - n 1))
(setq pt1 (nth j ptlst))
(setq pt2 (nth ( + j 1) ptlst))
(setq di (distance pt1 pt2))
(setq ptm (c:cal "plt(pt1,pt2,0.5)"))
(setq ang (angle pt1 pt2))
(setq di (rtos di 2 2))
(setq entlist (list (cons 1 di)))
(setq txtlen ( car ( cadr (textbox entlist)))
(if ( and ( < ang ( * 3 (/ pi 2))) ( > ang (/ pi 2)))
(setq ang (angle pt2 pt1))
)
(setq ang1 ( + ang ( / pi 2)))
(setq pti ( polar ptm ang ( * -0.5 txtlen)))
(setq pti ( polar pti angl dv))
(setq pt3 ( polar pti ang dv))
(command "text" pti "" pt3 di)
(setq j ( + j 1))
)
(setq i ( + i 1))
)
)
)
(sttvar "osmode" os)
) (setq ptlst (cons pt ptlst))
)
)
)
(if ( = ( cdr (asspr 0 (setq pen1 (entget pen1)))) "LWPOLYLINE")
(progn (setq bhbj (cdr(assoc 70 pen1)))
(steq ptlst '())
(setq pen (cdr(assoc 90 pen1)))
(setq pen1 (member'(100 . "AcDbPolyline") pen1))
(setq i 6)
;;数据读取序号初值
(repeat pen
(setq pt (cdr(nth i pen1)))
(setq ptlst (append ptlst (list pt)))
(steq i ( + 4 i))
)
(if ( = (logand bhbj 1) 1)
(steq ptlst (cons pt ptlst))
)
)
)
(if ( = ( cdr (assoc 0 pen1)) "LINE")
(progn (steq pt1 (cdr (assoc 10 pen1)))
(setq pt2 (cdr (assoc 11 pen1)))
(setq ptlst (list pt1 pt2))
)
)
ptlst
)
(defun c:zjcd(/ ANG ANG1 DI DV ENTLIST I J
LEN N PT1 PT2 PT3 PTI PTLST PTM SS1
STM TXTLEN os
)
(if (null cal)
(arxload "geomcal")
)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ss1 (ssget'((-4 . "<OR")
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "LINE")
(-4 . "OR>")
)
)
)
(if ss1
(progn (initget 4 "")
(setq
dv (getreal
(strcat "\n 输入字高: <" rtos (getvar "textsize")) ">")
)
)
(if dv
(setvar "textsize" dv)
)
(initget 4 "")
(setq dv (getreal (strcat "\n 输入离线距离: <0.2>")))
(if (not dv)
(setq dv 0.2)
)
(setq i 0)
(setq len (sslength ss1))
(while ( < i len)
(setq stm (ssname ss1 i))
运行有错误。。。。
[检查文字 zjcd.lsp 正在加载...]
.
; 错误: 参数太多: (IF (= ( ... ) 1) (SETQ PTLST ( ... )) (SETQ N ( ... )) ... )
; 错误: 输入中含有多余的闭括号
; 检查完成.
求大神帮忙解决，谢谢
大哥，这个是所有程序的样子，您有空看看，麻烦了。。。谢谢哥
http://wenku.baidu.com/view/bdf4cbeb551810a6f52486f9.html

Answer 1

程序太乱了，你试下我写的这个吧，功能应该是你要的。
(defun $Vp->Lp ( opt )
(if (= (type opt) 'variant) (Vlax-SafeArray->List (Vlax-Variant-Value opt)) (Vlax-3d-Point opt) )
)

(defun $Len->Vob ( obj )
(if (= (type obj) 'vla-object) (Vlax-Vla-Object->Ename obj) (Vlax-Ename->Vla-Object obj) )
)

(defun c:qxc ( / &doc &mod &sel #cm #os &ob #si #sn @pl )
(if (null vlax-dump-object) (vl-load-com) )
(setq &doc (vla-get-activedocument (vlax-get-acad-object)) &mod (vla-get-modelspace &doc))
(if (setq &sel (ssget '((-4 . "<OR") (0 . "POLYLINE") (0 . "LWPOLYLINE") (0 . "LINE") (-4 . "OR>"))))
(progn
(if (null #oth) (setq #oth (getvar "textsize")) )
(if (setq #th (getreal (strcat "\n请输入字高: <" (rtos #oth) "> "))) (setq #oth #th) (setq #th #oth) )
(if (null #oof) (setq #oof 0.2) )
(if (setq #of (getreal (strcat "\n请输入间距: <" (rtos #oof) "> "))) (setq #oof #of) (setq #of #oof) )
(setq #cm (getvar "cmdecho") #os (getvar "osmode")) (setvar "cmdecho" 0) (setvar "osmode" 0)
(repeat (setq @pl '() #si 0 #sn (sslength &sel))
(setq &ob ($Len->Vob (ssname &sel #si)) #si (1+ #si))
(cond
((= (vla-get-objectname &ob) "AcDbLine") ($lxc-addline &ob) )
((= (vla-get-objectname &ob) "AcDbPolyline") ($lxc-addpolyline &ob) )
)
)
($lxc-writetext @pl) (setvar "osmode" #os) (setvar "cmdecho" #cm)
)
(princ "\n未选择对象,程序退出!")
)
(princ)
)

(defun $lxc-writetext ( @pl / &tx @p1 @p2 @p3 #an #ds )
(foreach @cp @pl
(setq @p1 (nth 0 @cp) @p2 (nth 1 @cp) #an (angle @p1 @p2) #ds (distance @p1 @p2))
(setq @p3 (polar (polar @p1 #an (/ #ds 2.0)) (+ #an (/ pi 2)) (+ #of (/ #th 2.0))))
(setq &tx (vla-addtext &mod (rtos #ds) ($vp->lp @p3) #th))
(vla-put-alignment &tx 4) (vla-put-rotation &tx #an)
(vla-put-textalignmentpoint &tx ($vp->lp @p3))
)
)

(defun $lxc-addline ( &ob / )
(setq @pl (cons (list ($Vp->Lp (vla-get-startpoint &ob)) ($Vp->lp (vla-get-endpoint &ob))) @pl))
)

(defun $lxc-addpolyline ( &ob / )
(foreach ob ($vp->lp (vla-explode &ob))
(if (= (vla-get-objectname ob) "AcDbLine") ($lxc-addline ob) )
(vla-erase ob)
)
)
命令是qxc

Answer 2

程序太长，建议自己用CAD自动的编辑器调试下

追问

我调试过了，就是上面的错误，关键是，我只要用这个程序，不用懂的。。。所以，程序，我也不太懂，按书上抄的

追答

你要分开，一句句测试，实在不行，加我好友吧

Answer 3

试着给你看了下，因为你这个程序不完整，无法给你解决

追问

就是那个网址是原程序的地址。。。我是按照上面打的，当然，你也可以搜，边长长度自动注记，这个，不好意思，最近没上网，耽误时间了