坐标未正确更新
我几个月前从李·麦克那里得到了这段代码，除了一件事之外，它工作得很好。“PT2”Y坐标未正确填充属性。有人能帮忙吗。
属性：
http://onesourcecable.com/coords.jpg
代码：
; 这用于更新ftg块中的PT1和PT2属性
;
（defun lcoord（/lEnt bEnt vEnt sPt ePt aEnt aEntLst）
（命令“pickbox”“8”）
（vl load com）
（如果（和）（setq）
（汽车
（entsel）
“\n选择行，然后选择片段块>”）
（成员（cdr（assoc 0（entget lEnt）））'（“LINE”“POLYLINE”“LWPOLYLINE”“SPLINE”“ARC”））
（setq bEnt（car（entsel“\n选择目标块>”））
（=（cdr（assoc 0（entget bEnt）））“插入”）
（=（cdr（assoc 66（entget bEnt）））1）
（程序
（setq vEnt（vlax ename->vla object lEnt）
sPt（vlax曲线getStartPoint vEnt）
ePt（vlax curve getEndPoint vEnt）
aEnt（entnext bEnt））
（while（/=“SEQEND”（cdr（assoc 0（setq aEntLst（entget aEnt 1070;）））））
（条件（（=“PT1”（cdr（assoc 2 aEntLst）））
（setq aEntLst（subst（cons 1
（strcat（in2ft（汽车sPt））
; （chr 32）
","
; （chr 32）（in2ft（cadr sPt））（chr 32“，”
; （chr 32）（in2ft（caddr sPt）））
; （chr 32）
（in2ft（cadr ePt）））
（assoc 1 aEntLst）
aEntLst）
（entmod aEntLst）
（（=“PT2”（cdr（assoc 2 aEntLst）））
（setq aEntLst（subst（cons 1
（strcat（in2ft（car ePt））
; （chr 32）
","
; （chr 32）（in2ft（cadr ePt））（chr 32“，”
; （chr 32）（in2ft（caddr ePt）））
; （chr 32）
（in2ft（cadr ePt）））
（assoc 1 aEntLst）
aEntLst）
（entmod aEntLst）））
（setq aEnt（entnext aEntЮЮ）Ю）
（命令“PICKBOX”“6”）
（普林斯） 如果那是我的，那么我认为它已经被修改了。。。 乍一看，为什么所有的分号？
; This is for updating PT1 and PT2 attributes in ftg block
;
(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(command "pickbox" "8")
(vl-load-com)
(if (and (setq lEnt
(car
(entsel
"\nSelect Line then Footage block > " )))
(member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
(setq bEnt (car (entsel "\nSelect Destination Block > ")))
(= (cdr (assoc 0 (entget bEnt))) "INSERT")
(= (cdr (assoc 66 (entget bEnt))) 1))
(progn
(setq vEnt (vlax-ename->vla-object lEnt)
sPt (vlax-curve-getStartPoint vEnt)
ePt (vlax-curve-getEndPoint vEnt)
aEnt (entnext bEnt))
(while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
(cond ((= "PT1" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1
(strcat (in2ft (car sPt))
; (chr 32)
","
; (chr 32) (in2ft (cadr sPt)) (chr 32) ","
; (chr 32) (in2ft (caddr sPt))))
; (chr 32)
(in2ft (cadr ePt))))
(assoc 1 aEntLst)
aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1
(strcat (in2ft (car ePt))
; (chr 32)
","
; (chr 32) (in2ft (cadr ePt)) (chr 32) ","
; (chr 32) (in2ft (caddr ePt))))
; (chr 32)
(in2ft (cadr ePt))))
(assoc 1 aEntLst)
aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))
(COMMAND "PICKBOX" "6")
(princ)) 这只是我最初的编码秃鹰，不用担心。
我不确定，因为我提到“第一眼”。
只是看起来很奇怪。 试试这个Cabltv：
(defun c:lcoord (/ ent blk Obj lObj ePt sPt)
(vl-load-com)
(defun *error* (msg)
(if oPk (setvar "PICKBOX" oPk))
(if (not
(wcmatch
(strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n<< Error: " msg " >>")))
(princ))
(setq oPk (getvar "PICKBOX"))
(setvar "PICKBOX"
(while
(progn
(setq ent (car (entsel "\nSelect Line: ")))
(cond
((and (eq 'ENAME (type ent))
(wcmatch (cdr (assoc 0 (entget ent))) "*LINE"))
(while
(progn
(setq blk (car (entsel "\nSelect Block: ")))
(cond
((and (eq 'ENAME (type blk))
(eq "AcDbBlockReference"
(vla-get-ObjectName
(setq Obj (vlax-ename->vla-object blk)))))
(if (not (eq :vlax-true (vla-get-HasAttributes Obj)))
(princ "\n** Block is Not Attributed **")))
(t (princ "\n** Object is not a Block **"))))))
(t (princ "\n** Object is not a *Line **")))))
(setq lObj (vlax-ename->vla-object ent)
sPt (vlax-curve-getStartPoint lObj)
ePt (vlax-curve-getEndPoint lObj))
(foreach att (vlax-safearray->list
(vlax-variant-value
(vla-getAttributes Obj)))
(cond ((eq "PT1" (vla-get-tagString att))
(vla-put-TextString att
(strcat
(in2ft (car sPt)) (chr 44)
(in2ft (cadr sPt)) (chr 44)
(in2ft (caddr sPt)))))
((eq "PT2" (vla-get-TagString att))
(vla-put-TextString att
(strcat
(in2ft (car ePt)) (chr 44)
(in2ft (cadr ePt)) (chr 44)
(in2ft (caddr ePt)))))))
(setvar "PICKBOX" oPk)
(princ))
(defun in2ft (num / ft in)
(setq ft (fix (/ num 12.0))
in (rem num 12.0))
(strcat (rtos ft 2 2) (chr 39) (chr 45)
(rtos in 2 2) (chr 34)))
我认为原稿修改不正确。 李几个月前为我创作了这个。我忘了我把那些部分注释掉了。现在我知道为什么了。
我刚刚删除了这些部分的分号，并尝试加载Lisp文件，收到了以下错误。。。
“命令：；错误：错误的参数类型：lentyp nil”。
如果我把分号放回，它就会加载而不会出错。 你不能只删除分号-括号（方括号）将不正确。 李，
我从1月29日回到了原始代码，并尝试了它，结果是一样的，但我当时没有注意到。
http://www.cadtutor.net/forum/showthread.php?t=31962&highlight=cabltv1 你试过我上面贴的Lisp程序吗？
页:
[1]
2