生成二维多段线？
(defun vxs (e / i v lst ppp)
(setq i 0)
(while
(setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
(setq lst (cons v lst))
)
(setq ppp (reverse lst) )
(append (list(vlax-curve-getpointatparam e 0)) ppp )
)
(vl-load-com)
;(vla-AddPolyline (vxs(car(entsel)))) (vla-addlightweightpolyline (vxs(car(entsel))))
(setq plst nil)
(setq plst (vxs(car(entsel))) )
(setq plst1 (apply 'append
(append plst (list (car plst)))
) )
(setq points
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length plst1) 1))
)
)
(vlax-safearray-fill points plst1)
(setq ms
(vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
(vla-AddPolyline ms points )
;求解二点距离子函数
(defun mdist(pt0 pt1 / opt tpt)
(setq x0 (nth 0 pt0) y0 (nth 1 pt0))
(setq x1 (nth 0 pt1) y1 (nth 1 pt1))
(setq dx (- x0 x1) dy (- y0 y1))
(setq xddist (sqrt (+ (* dx dx) (* dy dy))))
)
;-----------------------------
(defun c:pladp( / addAn arcAn arcEP arcR arcSP cenPT code70 endpt
fwjCE fwjCM fwjCS fwjSE i ii j jiaJ layli laynam
midpt midptl npldat pldat repnum res sn ssp ssp1
sspt startp startpt strin syscmd tmpels totalp entlt entth entco)
(command "undo" "BE")
(setq syscmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(prompt "\n多义线孤线段加点:")
(setq sn (getreal "\n输入近似多段线的单位长度<1.0>: "))
(if (= sn nil) (setq sn 1.0))
(initget "1 2")
(setq res (getkword "\n 请选择转换方式：1 按图层/2 人为选择(缺省为2):"))
(if (= res nil) (setq res "2"))
(cond ((= res "1")
(setq laynam (getstring "\n 图层名："))
(setq layli (cons 8 laynam))
(setq ssp (ssget "X" (list (cons 8 laynam) (cons0"POLYLINE"))))
(setq ssp1 (ssget "X" (list (cons 8 laynam) (cons0"LWPOLYLINE"))))
(setq i 0)
(repeat (sslength ssp1) (ssadd (ssnamessp1 i) ssp) (setq i (1+ i))))
((= res "2")
(prompt "\n 请选择需转换的实体(可窗选，自动过滤出多义线实体):")
(setq ssp (ssget '((-4 . "<OR") (0 . "LWPOLYLINE") (0 . "POLYLINE") (-4 . "OR>"))))
)
);cond
(princ "\n ...正在转换...")
(command "layer" "m" "df-point" "")
(command "ERASE" (ssget "x" '((8 . "df-point") (0 . "POINT"))))
(while ssp
(setq i 0 )
(repeat (sslength ssp)
(setqnpldat nil chanyn nil j 0)
(setq pldat (entget (ssname ssp i) '("*")))
(print (cdr (assoc 5 pldat)))
(setq code70 (cdr (assoc 70 pldat)))
(while (and (< j (length pldat))(= (cdr (assoc 0 pldat)) "LWPOLYLINE"))
(if (= (car (nth j pldat)) 42) (/= (cdr (nth j pldat)) 0.0) (progn (setq chanyn T) (setq j (length pldat))))
)
(cond ( (and (= (cdr (assoc 0 pldat)) "LWPOLYLINE")chanyn)
(setq startpt (assoc 10 pldat))
(setq endpt (assoc 10 (reverse pldat)))
(setq npldat nil)
(setq j 0 totalp 0)
(while (< j (length pldat))
(if (and (= (car (nth j pldat)) 10)(= (car (nth (+ j 3) pldat)) 42) (/= (cdr (nth (+ j 3) pldat)) 0.0) )
(progn
(setq midptl (list (nth j pldat) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0)))
(setq totalp (1+ totalp))
(setq npldat (append npldat midptl))
(setq arcSP (cdr (nth j pldat)))
(setq arcEP (cdr (nth (+ j 4) pldat)))
(if(and (> (abs (- (/ code70 2.0) (fix (/ code70 2.0)))) 0.49) (= (car (nth (+ j 4) pldat)) 210))
(setq arcEP (cdr (assoc 10 pldat))));if
(setq arcAn (* (atan (cdr (nth (+ j 3) pldat))) 2))
(setq strin (/ (mdist arcSP arcEP) 2))
(setq arcR (/ strin (sin arcAn)))
(setq fwjSE (angle arcSP arcEP))
(setq cenPT (polar arcSP (+ fwjSE (- (/ pi 2.0) arcAn)) arcR))
(setq fwjCS (angle cenPT arcSP))
(setq fwjCE (angle cenPT arcEP))
(setq jiaJ (abs (- fwjCE fwjCS)))
(if (and (> fwjCE fwjCS) (< (cdr (nth (+ j 3) pldat)) 0)) (setq jiaj (- (* pi 2.0) jiaj)))
(if (and (< fwjCE fwjCS) (> (cdr (nth (+ j 3) pldat)) 0)) (setq jiaj (- (* pi 2.0) jiaj)))
(setq addAn(/ sn arcR))
(setq fwjCM (+ fwjCS addAn))
(setq repnum (fix (abs (/ jiaj addAn))))
(if(and (< (abs (- (/ code70 2.0) (fix (/ code70 2.0)))) 0.001) (= (car (nth (+ j 4) pldat)) 210))
(progn
(setq repnum 0)
(setq npldat (append npldat (list (nth j pldat))))
(setq totalp (1+ totalp))
)
(repeat repnum
(setq midpt (polar cenPT fwjCM (abs arcR)))
(setq midptl (list (cons '10 midpt) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0)))
(setq totalp (1+ totalp))
(setq npldat (append npldat midptl))
(setq fwjCM (+ fwjCM addAn)));r
);if
(setq j (+ 3 j))
);pr
(progn (setq npldat (append npldat (list (nth j pldat))))
(if (= (car (nth j pldat)) 10) (setq totalp (1+ totalp)) ))
);if
(setq j (1+ j))
);wh
(setq npldat (subst(cons 90 totalp) (assoc 90 npldat) npldat))
(entmod npldat)
);cond-1
((= (cdr (assoc 0 pldat)) "POLYLINE")
(if (or (= code70 2) (= code70 3) (= code70 4) (= code70 5)
(= code70 130) (= code70 131) (= code70 132) (= code70 133))
(progn
(getplp (ssname ssp i))
;(command "pedit" (ssname ssp i) "D" "")
;(setq tmpels (entget (ssname ssp i)))
;(setq startp (assoc 10 tmpels))
;(setq endpt (assoc 10 (reverse tmpels)))
(setq startp (cons 10 (car plpt)))
(setq endpt (cons 10 (last plpt)))
(command "layer" "s" "df-point" "")
(if (> (mdist (car plpt) (last plpt)) (* sn 2.0)) (command "measure" (ssname ssp i) sn) (command "measure" (ssname ssp i) (/ (mdist (car plpt) (last plpt)) 3.0)))
(setq sspt nil)
(setq sspt (ssget "x" '((8 . "df-point") (0 . "POINT"))))
(if (= (setq entlt (cdr (assoc 6 pldat))) nil) (setq entlt "bylayer") )
(if (= (setq entth (cdr (assoc 39 pldat))) nil) (setq entth 0) )
(if (= (setq entco (cdr (assoc 62 pldat))) nil) (setq entco "bylayer") )
(command "clayer" (cdr (assoc 8 pldat)) "color" entco "celtype" entlt "thickness" entth)
(entmake pldat)
(setq ii (1- (sslength sspt)))
(if (< (abs (- (/ code70 2.0) (fix (/ code70 2.0)) ))0.01) (entmake (list '(0 . "VERTEX") startp)))
(repeat (sslength sspt)
(setq tmpels (assoc 10 (entget (ssname sspt ii))))
(entmake (list '(0 . "VERTEX") tmpels))
(setq ii (1- ii)) );r
(if (< (abs (- (/ code70 2.0) (fix (/ code70 2.0))))0.01) (entmake (list '(0 . "VERTEX") endpt)))
(entmake (list '(0 . "SEQEND")))
(command "_.erase" sspt "")
(entdel(ssname ssp i))
(command "pedit" (entlast) "d" "")
));pr;if
);cond-2
);cond
(setq i (1+ i))
);r
(setq ssp nil)
);wh
;(command "undo" "E")
(setvar "cmdecho" syscmd)
(princ)
)
页:
[1]