Error Code
Hi Victor,
if I understand correctly your goal...
(defun c:sd2 (/ e i x ss)
(if (or (null ofd)
(/= (type ofd) 'REAL)
)
(setq ofd 74.)
)
(if (setq ss (ssget "all"))
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(if (vlax-method-applicable-p e 'Offset)
(vl-every '(lambda (x) (vl-catch-all-apply 'vla-offset (list e x))) (list ofd (- ofd)))
)
)
)
(princ)
)
Hope this helps,
Henrique
Hi Victor,
instead of a .png file, post a .dwg file and I'll see what I can do...
Are you going to process only one polyline per dwg and in the current layout?
Henrique
Hi Victor,
Sorry, but I'm with a large workload, and I don't have much free time...
Try this 'quick and dirty' and minimally tested 'demo', with a different approach, not using 'offset'.
The 'demo':
- expects only one 'lwpolyline' in WCS in the dwg
- expects the 'lwpolyline' with a layer 'xxx_#'
- don't deals with the 'TXT_##' layer color (I could not find a relationship between the 'Type_##' layer color, and the 'TXT_##' layer color)
- don't deals with the text style you have in the 'sample.dwg'
- don't deals with the linetype scale in the layer 'Hidden'
Probably, don't deals with many more things!
See this 'demo' only as a starting point.
(vl-load-com)
(defun c:demo (/ *error* mk_txt adoc clay dist echo ent lay layn llpt llpt+ llpt- lpt_txt lrpt lrpt+ pl-list pos pt pts ss txt1 txt2 ulpt ulpt+ upt_txt urpt
urpt+)
(defun *error* (msg)
(if clay
(setvar 'CLAYER clay)
)
(if echo
(setvar 'CMDECHO echo)
)
(vla-endundomark adoc)
(cond
((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n** Error: " msg " ** ")))
)
(princ)
)
(defun mk_txt (pt str)
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbText")
(cons 10 pt)
(cons 40 100.)
(cons 1 str)
(cons 100 "AcDbText")
)
)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(if (and (setq ss (ssget "_X"
'((0 . "LWPOLYLINE") (90 . 4) (70 . 1) (-4 . "<NOT") (-4 . "<>") (42 . 0.0) (-4 . "NOT>"))
)
)
(= (sslength ss) 1)
(setq ent (entget (ssname ss 0)))
(setq lay (cdr (assoc 8 ent)))
(wcmatch lay "Type_#*")
(setq pos (vl-string-position (ascii "_") lay))
(setq layn (strcat "TXT" (substr lay (1+ pos))))
(setq txt1 (strcat "Text" (substr lay (1+ pos))))
(setq txt2 (strcat (substr lay 1 pos) " _ " (substr lay (+ pos 2))))
(setq clay (getvar 'CLAYER))
(setq echo (getvar 'CMDECHO))
(setvar 'CMDECHO 0)
)
(progn
(if (or (null ofd)
(/= (type ofd) 'REAL)
)
(setq ofd 74.)
)
(setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) ent)))
(setq pts (vl-sort pts
'(lambda (a b) (or (< (cadr a) (cadr b)) (and (= (cadr a) (cadr b)) (<= (car a) (car b)))))
)
)
(if (< (car (nth 0 pts)) (car (nth 1 pts)))
(setq llpt (nth 0 pts)
lrpt (nth 1 pts)
)
(setq lrpt (nth 0 pts)
llpt (nth 1 pts)
)
)
(if (< (car (nth 2 pts)) (car (nth 3 pts)))
(setq ulpt (nth 2 pts)
urpt (nth 3 pts)
)
(setq urpt (nth 2 pts)
ulpt (nth 3 pts)
)
)
(setq pl-list (cons llpt pl-list)
pl-list (cons (setq llpt+ (polar llpt (* pi 1.5) ofd)) pl-list)
pl-list (cons (polar llpt+ (angle llpt lrpt) (distance llpt lrpt)) pl-list)
pl-list (cons lrpt pl-list)
pl-list (cons (setq lrpt+ (polar lrpt (/ pi 6.) (* ofd (/ 2. (sqrt 3))))) pl-list)
pl-list (cons (polar lrpt+ (angle lrpt urpt) (distance lrpt urpt)) pl-list)
pl-list (cons urpt pl-list)
pl-list (cons (setq urpt+ (polar urpt (* pi 0.5) ofd)) pl-list)
pl-list (cons (polar urpt+ (angle urpt ulpt) (distance urpt ulpt)) pl-list)
pl-list (cons ulpt pl-list)
pl-list (cons (setq ulpt+ (polar ulpt (+ (/ pi 6.) pi) (* ofd (/ 2. (sqrt 3))))) pl-list)
pl-list (cons (setq llpt- (polar ulpt+ (angle ulpt llpt) (distance ulpt llpt))) pl-list)
pl-list (cons llpt pl-list)
)
; (setq pl-list nil)
(setvar 'CLAYER lay)
(entmake
(append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pl-list))
'(70 . 1)
)
(mapcar '(lambda (pt) (cons 10 pt)) pl-list)
)
)
(setq lpt_txt (list (car llpt-) (cadr llpt))
upt_txt (list (car llpt-) (cadr ulpt))
dist (/ (- (distance lpt_txt upt_txt) 285.) 2.)
)
(command "_.layer" "_M" layn "")
(mk_txt (polar lpt_txt (angle lpt_txt upt_txt) dist) txt1)
(mk_txt (polar lpt_txt (angle lpt_txt upt_txt) (+ dist 185.)) txt2)
(command "_.layer" "_M" "Hidden" "_C" 8 "" "_L" "Hidden" "" "")
(entmod (subst (cons 8 "Hidden") (assoc 8 ent) ent))
)
)
(*error* nil)
(princ)
)
Hope this helps,
Henrique
You're welcome, Victor!
As I had already said in my previous post, I'm with a large workload, and I don't have much free time...
Now it's time for you try to put the code together.
Henrique
